| Code |
N VISIT,VSTR,ILST,LOC,CODE,PRIM,QTY,CAT,NARR,PRV,X0,X12,X802,X811,VTYP
N IPOV,ICPT,IPRV,IIMM,ISK,IPED,IHF,IXAM,ITRT,ICOM,MIDX,MIEN,MCNT,MODS
I +$G(IEN)<1 D I 1 ; Get PCE Data on a new note not yet saved
. S (X0,X12)=""
. S VISIT=$$GETENC^PXAPI(DFN,$P(VSITSTR,";",2),$P(VSITSTR,";"))
. S VSTR=VSITSTR
E D
. S X0=^TIU(8925,IEN,0),X12=$G(^(12))
. S VISIT=$P(X12,U,7)
. I 'VISIT S VISIT=$P(X0,U,3)
. D NOTEVSTR^ORWPCE(.VSTR,IEN)
S VTYP=$P(VSTR,";",3)
S ILST=1
S ICOM=0
S LST(1)="HDR"_U_("HID"[VTYP)_U_$P(X0,U,11)_U_VSTR_U_$P(X12,U,2)
S LST(1)=LST(1)_U_0
I VISIT'>0 D Q
. I $G(VSTR)'="" M LST=^TMP("ORWPCE",$J,VSTR) ; get cached visit data
I $P(LST(1),U,2),VTYP="H" Q ; quit if admission
K ^TMP("PXKENC",$J)
D ENCEVENT^PXAPI(VISIT)
I '$D(^TMP("PXKENC",$J,VISIT,"VST",VISIT,0)) Q
S $P(LST(1),U,6)=$D(^TMP("PXKENC",$J,VISIT,"CPT"))\10
S X0=^TMP("PXKENC",$J,VISIT,"VST",VISIT,0),LOC=+$P(X0,U,22)
S ILST=ILST+1,LST(ILST)="VST^DT^"_$P(X0,U)
S ILST=ILST+1,LST(ILST)="VST^PT^"_$P(X0,U,5)
S ILST=ILST+1,LST(ILST)="VST^HL^"_LOC_"^^"_$P($G(^SC(LOC,0)),U)
S ILST=ILST+1,LST(ILST)="VST^PS^0" ;outpt
N VAL
D SCSEL^ORWPCE(.VAL,$P(X0,U,5),$P(X0,U),LOC,VISIT)
S ILST=ILST+1,LST(ILST)="VST^SC^"_$P($P(VAL,";",1),U,2)
S ILST=ILST+1,LST(ILST)="VST^AO^"_$P($P(VAL,";",2),U,2)
S ILST=ILST+1,LST(ILST)="VST^IR^"_$P($P(VAL,";",3),U,2)
S ILST=ILST+1,LST(ILST)="VST^EC^"_$P($P(VAL,";",4),U,2)
S ILST=ILST+1,LST(ILST)="VST^MST^"_$P($P(VAL,";",5),U,2)
I $P(VAL,";",6)'="" D
.S ILST=ILST+1,LST(ILST)="VST^HNC^"_$P($P(VAL,";",6),U,2)
I $P(VAL,";",7)'="" D
.S ILST=ILST+1,LST(ILST)="VST^CV^"_$P($P(VAL,";",7),U,2)
S IPRV=0 F S IPRV=$O(^TMP("PXKENC",$J,VISIT,"PRV",IPRV)) Q:'IPRV D
. S X0=^TMP("PXKENC",$J,VISIT,"PRV",IPRV,0)
. ;Q:$P(X0,U,4)'="P"
. S CODE=$P(X0,U),NARR=$P($G(^VA(200,CODE,0)),U)
. S PRIM=($P(X0,U,4)="P")
. S ILST=ILST+1
. S LST(ILST)="PRV"_U_CODE_"^^^"_NARR_"^"_PRIM
S IPOV=0 F S IPOV=$O(^TMP("PXKENC",$J,VISIT,"POV",IPOV)) Q:'IPOV D
. N ICDCSYS
. S X0=^TMP("PXKENC",$J,VISIT,"POV",IPOV,0),X802=$G(^(802)),X811=$G(^(811))
. S CODE=$P(X0,U),NARR=$P(X0,U,4),ICDCSYS=$$SAB^ICDEX($$CSI^ICDEX(80,CODE),DT)
. I CODE D
. . S CODE=$P($$ICDDATA^ICDXCODE(ICDCSYS,CODE,DT),U,2)
. . S NARR=$$SETNARR(NARR,CODE)
. S CAT=$P(X802,U)
. S:CAT CAT=$P(^AUTNPOV(CAT,0),U)
. S PRIM=($P(X0,U,12)="P")
. S PRV=$P(X12,U,4)
. S ILST=ILST+1
. S LST(ILST)="POV"_U_CODE_U_CAT_U_NARR_U_PRIM_U_PRV
. I X811]"" D
.. S ICOM=ICOM+1
.. S $P(LST(ILST),U,10)=ICOM
.. S ILST=ILST+1
.. S LST(ILST)="COM"_U_ICOM_U_X811
S ICPT=0 F S ICPT=$O(^TMP("PXKENC",$J,VISIT,"CPT",ICPT)) Q:'ICPT D
. S X0=^TMP("PXKENC",$J,VISIT,"CPT",ICPT,0),X802=$G(^(802)),X12=$G(^(12)),X811=$G(^(811))
. S CODE=$$CODEC^ICPTCOD($P(X0,U)) ;ICR #1995
. S:CODE=-1 CODE=""
. S CAT=$P(X802,U)
. S:CAT CAT=$P(^AUTNPOV(CAT,0),U)
. S NARR=$P(X0,U,4)
. S:NARR NARR=$P(^AUTNPOV(NARR,0),U)
. S QTY=$P(X0,U,16)
. S PRV=$P(X12,U,4)
. S MCNT=0,MIDX=0,MODS=""
. F S MIDX=$O(^TMP("PXKENC",$J,VISIT,"CPT",ICPT,1,MIDX)) Q:'MIDX D
. . S MIEN=$G(^TMP("PXKENC",$J,VISIT,"CPT",ICPT,1,MIDX,0))
. . I +MIEN S MCNT=MCNT+1,MODS=MODS_";/"_MIEN
. I +MCNT S MODS=MCNT_MODS
. S ILST=ILST+1
. S LST(ILST)="CPT"_U_CODE_U_CAT_U_NARR_U_QTY_U_PRV_U_U_U_MODS
. I X811]"" D
.. S ICOM=ICOM+1
.. S $P(LST(ILST),U,10)=ICOM
.. S ILST=ILST+1
.. S LST(ILST)="COM"_U_ICOM_U_X811
S IIMM=0 F S IIMM=$O(^TMP("PXKENC",$J,VISIT,"IMM",IIMM)) Q:'IIMM D
. S X0=^TMP("PXKENC",$J,VISIT,"IMM",IIMM,0),X12=$G(^(12)),X811=$G(^(811))
. S CODE=$P(X0,U)
. S:CODE NARR=$P(^AUTTIMM(CODE,0),U)
. S QTY=$P(X0,U,4)
. S CAT=""
. S PRV=$P(X12,U,4)
. S ILST=ILST+1
. S LST(ILST)="IMM"_U_CODE_U_CAT_U_NARR_U_QTY_U_PRV_U_$P(X0,U,6,7)
. I X811]"" D
.. S ICOM=ICOM+1
.. S $P(LST(ILST),U,10)=ICOM
.. S ILST=ILST+1
.. S LST(ILST)="COM"_U_ICOM_U_X811
S ISK=0 F S ISK=$O(^TMP("PXKENC",$J,VISIT,"SK",ISK)) Q:'ISK D
. S X0=^TMP("PXKENC",$J,VISIT,"SK",ISK,0),X12=$G(^(12)),X811=$G(^(811))
. S CODE=$P(X0,U)
. S:CODE NARR=$P(^AUTTSK(CODE,0),U)
. S QTY=$P(X0,U,4)
. S CAT=""
. S PRV=$P(X12,U,4)
. S ILST=ILST+1
. S LST(ILST)="SK"_U_CODE_U_CAT_U_NARR_U_QTY_U_PRV_U_$P(X0,U,5,6)_U_$P(X12,U)
. I X811]"" D
.. S ICOM=ICOM+1
.. S $P(LST(ILST),U,10)=ICOM
.. S ILST=ILST+1
.. S LST(ILST)="COM"_U_ICOM_U_X811
S IPED=0 F S IPED=$O(^TMP("PXKENC",$J,VISIT,"PED",IPED)) Q:'IPED D
. S X0=^TMP("PXKENC",$J,VISIT,"PED",IPED,0),X12=$G(^(12)),X811=$G(^(811))
. S CODE=$P(X0,U)
. S:CODE NARR=$P(^AUTTEDT(CODE,0),U)
. S QTY=$P(X0,U,6)
. S CAT=""
. S PRV=$P(X12,U,4)
. S ILST=ILST+1
. S LST(ILST)="PED"_U_CODE_U_CAT_U_NARR_U_QTY_U_PRV
. I X811]"" D
.. S ICOM=ICOM+1
.. S $P(LST(ILST),U,10)=ICOM
.. S ILST=ILST+1
.. S LST(ILST)="COM"_U_ICOM_U_X811
S IHF=0 F S IHF=$O(^TMP("PXKENC",$J,VISIT,"HF",IHF)) Q:'IHF D
. S X0=^TMP("PXKENC",$J,VISIT,"HF",IHF,0),X12=$G(^(12)),X811=$G(^(811))
. S CODE=$P(X0,U)
. S:CODE NARR=$P(^AUTTHF(CODE,0),U)
. S QTY=$P(X0,U,4)
. S CAT=""
. S PRV=$P(X12,U,4)
. S ILST=ILST+1
. S LST(ILST)="HF"_U_CODE_U_CAT_U_NARR_U_QTY_U_PRV
. I X811]"" D
.. S ICOM=ICOM+1
.. S $P(LST(ILST),U,10)=ICOM
.. S ILST=ILST+1
.. S LST(ILST)="COM"_U_ICOM_U_X811
S IXAM=0 F S IXAM=$O(^TMP("PXKENC",$J,VISIT,"XAM",IXAM)) Q:'IXAM D
. S X0=^TMP("PXKENC",$J,VISIT,"XAM",IXAM,0),X12=$G(^(12)),X811=$G(^(811))
. S CODE=$P(X0,U)
. S:CODE NARR=$P(^AUTTEXAM(CODE,0),U)
. S QTY=$P(X0,U,4)
. S CAT=""
. S PRV=$P(X12,U,4)
. S ILST=ILST+1
. S LST(ILST)="XAM"_U_CODE_U_CAT_U_NARR_U_QTY_U_PRV_U_$P(X0,U,6,7)
. I X811]"" D
.. S ICOM=ICOM+1
.. S $P(LST(ILST),U,10)=ICOM
.. S ILST=ILST+1
.. S LST(ILST)="COM"_U_ICOM_U_X811
S ITRT=0 F S ITRT=$O(^TMP("PXKENC",$J,VISIT,"TRT",ITRT)) Q:'ITRT D
. S X0=^TMP("PXKENC",$J,VISIT,"TRT",ITRT,0),X802=$G(^(802)),X12=$G(^(12)),X811=$G(^(811))
. S CODE=$P(X0,U)
. S QTY=$P(X0,U,4)
. S CAT=$P(X802,U)
. S NARR=$P(X0,U,6)
. S:CAT CAT=$P(^AUTNPOV(CAT,0),U)
. S:NARR NARR=$P(^AUTNPOV(NARR,0),U)
. S PRV=$P(X12,U,4)
. S ILST=ILST+1
. S LST(ILST)="TRT"_U_CODE_U_CAT_U_NARR_U_QTY_U_PRV
. I X811]"" D
.. S ICOM=ICOM+1
.. S $P(LST(ILST),U,10)=ICOM
.. S ILST=ILST+1
.. S LST(ILST)="COM"_U_ICOM_U_X811
|