ORWPCE3 ; SLC/KCM/REV/JM/TC - Get a PCE encounter for a TIU document ;Aug 22, 2023@08:55
;;3.0;ORDER ENTRY/RESULTS REPORTING;**10,85,116,190,280,306,371,361,385,377,498,405,598,588,606**;Dec 17, 1997;Build 3
;
; Reference to ENCEVENT^PXAPI in ICR #1894
; Reference to $$ICDDATA^ICDXCODE in ICR #5747
; Reference to VSKIN^PXPXRM in ICR #4250
; Reference to VIMM^PXPXRM in ICR #4250
; Reference to VICR^PXPXRM in ICR #4250
; Reference to ^AUTNPOV( in ICR #1593
; Reference to GETFIND^PXRMRPCG in ICR #6839
; Reference to ICDDESC^ICDXCODE in ICR #5747
; Reference to $$SENTENCE^XLFSTR in ICR #10104
; Reference to ^AUPNVSIT( in ICR #2028
; Reference to ^AUTTEDT( in ICR #1987
; Reference to ^AUTTEXAM( in ICR #1988
; Reference to ^AUTTHF( in ICR #1989
; Reference to ^TIU(8925, in ICR #2937
; Reference to $$CODECS^ICDEX in ICR #5747
; Reference to $$CSI^ICDEX in ICR #5747
; Reference to $$SAB^ICDEX in ICR #5747
;
PCE4NOTE(LST,IEN,DFN,VSITSTR) ; Return encounter for an associated note IA#4214,6132,6614
; LST(1)=HDR^AllowEdit^CPTRequired^VStr^Author^hasCPT^VisitIEN
; LST(n)=TYP+^CODE^CAT^NARR^QUAL1^QUAL2 (QUAL1=Primary!Qty, QUAL2=Prv)
N VISIT,VSTR,ILST,OLST,LOC,LOTNODE,NODE,CODE,MANUF,ORPRMPTS,PRIM,QTY,CAT,NARR,PRV
N X,X0,X2,X12,X13,X16,X802,X811,VTYP,IPOV,ICPT,IPRV,IIMM,ISK,IPED,IHF,IXAM,ITRT
N ICOM,ISSECV,MIDX,MIEN,MCNT,MODS,VIS,VISCNT,VISTEMP,CPIECE,GFINDS,GCNT,ITEM,ORDATA
N ORPARR,ORPVAL,ORSUB,TOPLST,IST,X220,MAG,UCUM,PRIMARY,SUB,TEMP,SYSTEM,SYSIEN
S PRIMARY=0
I +$G(IEN)<1 D I 1 ; Get PCE Data on a new note not yet saved
. S (X0,X12)=""
. S VSTR=$G(VSITSTR)
. S VISIT=$$GETVSIT^ORWPCE1(VSTR,$G(DFN))
. I 'VISIT S VISIT=-1
E D
. S X0=$G(^TIU(8925,IEN,0)),X12=$G(^(12))
. ;make sure DFN is defined for Reminder call at the end of the routine.
. I +$G(DFN)=0 S DFN=$P(X0,U,2)
. S VISIT=$P(X12,U,7),ISSECV=1
. I 'VISIT S VISIT=$P(X0,U,3),PRIMARY=1,ISSECV=0
. D NOTEVSTR^ORWPCE(.VSTR,IEN)
. ;address an issue with ancillary service that is clinic being reported by PCE as a ward location
. I ISSECV=0,$P(VSTR,";",3)="D",VISIT>0 D
. . I $P($G(^AUPNVSIT(VISIT,0)),U,7)="H" S VISIT=-1,PRIMARY=0
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)
;add hasCPT node
S LST(1)=LST(1)_U_0_U_VISIT_U_PRIMARY
I VISIT'>0 D G GETFIND
. 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)
D BLDPRMPT^ORFEDT(.ORPRMPTS)
D BLDPARR^ORFEDT(.ORPARR)
I '$D(^TMP("PXKENC",$J,VISIT,"VST",VISIT,0)) G GETFIND
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
;S X0=$G(^TMP("PXKENC",$J,VISIT,"VST",VISIT,800))
N VAL,SCNODE
S SCNODE=$G(^TMP("PXKENC",$J,VISIT,"VST",VISIT,800))
;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^SC^"_$P(SCNODE,U)
;S ILST=ILST+1,LST(ILST)="VST^AO^"_$P($P(VAL,";",2),U,2)
S ILST=ILST+1,LST(ILST)="VST^AO^"_$P(SCNODE,U,2)
;S ILST=ILST+1,LST(ILST)="VST^IR^"_$P($P(VAL,";",3),U,2)
S ILST=ILST+1,LST(ILST)="VST^IR^"_$P(SCNODE,U,3)
;S ILST=ILST+1,LST(ILST)="VST^EC^"_$P($P(VAL,";",4),U,2)
S ILST=ILST+1,LST(ILST)="VST^EC^"_$P(SCNODE,U,4)
;S ILST=ILST+1,LST(ILST)="VST^MST^"_$P($P(VAL,";",5),U,2)
S ILST=ILST+1,LST(ILST)="VST^MST^"_$P(SCNODE,U,5)
;I $P(VAL,";",6)'="" D
;.S ILST=ILST+1,LST(ILST)="VST^HNC^"_$P($P(VAL,";",6),U,2)
S ILST=ILST+1,LST(ILST)="VST^HNC^"_$P(SCNODE,U,6)
;I $P(VAL,";",7)'="" D
;.S ILST=ILST+1,LST(ILST)="VST^CV^"_$P($P(VAL,";",7),U,2)
S ILST=ILST+1,LST(ILST)="VST^CV^"_$P(SCNODE,U,7)
;I $P(VAL,";",8)'="" D
;.S ILST=ILST+1,LST(ILST)="VST^SHAD^"_$P($P(VAL,";",8),U,2)
S ILST=ILST+1,LST(ILST)="VST^SHAD^"_$P(SCNODE,U,8)
;for provider
; LST(n)="PRV"^ien^^^name^primary/secondary flag
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
ICR ;for contraindicated/refused:
S ITEM=0 F S ITEM=$O(^TMP("PXKENC",$J,VISIT,"ICR",ITEM)) Q:ITEM'>0 D
.K ORDATA D VICR^PXPXRM(ITEM,.ORDATA)
.S ILST=ILST+1,TOPLST=ILST
.S SUB="" F S SUB=$O(ORDATA(SUB)) Q:SUB="" D
..I ORDATA(SUB)="" Q
..I ORDATA(SUB)=U Q
..I SUB="REFUSED VACCINE GROUP" D Q
...S TEMP=ORDATA(SUB)
...S $P(LST(TOPLST),U,ORPRMPTS("pnumRefusedGroup"))='TEMP
..S ORPVAL=$G(ORPARR(SUB)) I ORPVAL="" Q
..I ORPVAL>0 D Q
...I ORPVAL=4 S $P(LST(TOPLST),U)="IMM",$P(LST(TOPLST),U,2)=+ORDATA(SUB),$P(LST(TOPLST),U,4)=$P(ORDATA(SUB),U,2) Q
...S $P(LST(TOPLST),U,ORPVAL)=$G(ORDATA(SUB))
..I ORPVAL="CONTRA" D Q
...S TEMP=ORDATA(SUB)
...I TEMP[920.4 S $P(LST(TOPLST),U,ORPRMPTS("pnumImmContra"))=$TR(TEMP,U,":") Q
...S $P(LST(TOPLST),U,ORPRMPTS("pnumImmRefused"))=$TR(TEMP,U,":")
..I ORPVAL="COMMENT",$G(ORDATA(SUB))'="" D Q
...S ICOM=ICOM+1
...S $P(LST(TOPLST),U,10)=ICOM
...S ILST=ILST+1,LST(ILST)="COM"_U_ICOM_U_ORDATA(SUB)
..S $P(LST(TOPLST),U,ORPRMPTS(ORPVAL))=$TR(ORDATA(SUB),U,";")
IMM ;for immunization:
; LST(n)="IMM"^Code^^^Series^prv^Reaction^Contraindicated^Refused
S IIMM=0 F S IIMM=$O(^TMP("PXKENC",$J,VISIT,"IMM",IIMM)) Q:'IIMM D
.K ORDATA D VIMM^PXPXRM(IIMM,.ORDATA)
.S ILST=ILST+1,TOPLST=ILST
.S LST(TOPLST)="IMM"_U
.S SUB="" F S SUB=$O(ORDATA(SUB)) Q:SUB="" D
..I SUB="VISIT DATE TIME" Q
..S ORPVAL=$G(ORPARR(SUB)) I ORPVAL="" Q
..I +ORPVAL>0 D Q
...I ORPVAL=4 S $P(LST(TOPLST),U,4)=$P($G(ORDATA(SUB)),U,2),$P(LST(TOPLST),U,2)=+ORDATA(SUB) Q
...S $P(LST(TOPLST),U,ORPVAL)=$G(ORDATA(SUB))
..I ORPVAL="pnumComment" D Q
...I $G(ORDATA(SUB))'="" D
....S ICOM=ICOM+1
....S $P(LST(TOPLST),U,10)=ICOM
....S ILST=ILST+1,LST(ILST)="COM"_U_ICOM_U_ORDATA(SUB)
..I ORPVAL="pnumImmOverride",$G(ORDATA(SUB))'="" D Q
...S ICOM=ICOM+1
...S $P(LST(TOPLST),U,24)=ICOM
...S ILST=ILST+1,LST(ILST)="COM"_U_ICOM_U_ORDATA(SUB)
..I ORPVAL="pnumIMMVIS" D Q
...S VIS=""
...S VISCNT=0 F S VISCNT=$O(ORDATA(SUB,VISCNT)) Q:VISCNT'>0 D
....S VISTEMP=$TR($P(ORDATA(SUB,VISCNT,0),U,1,2),U,"/")
....I VIS'="" S VIS=VISTEMP_";"_VISTEMP Q
....S VIS=VISTEMP
...I VIS'="" S $P(LST(TOPLST),U,21)=VIS
..I $G(ORPRMPTS(ORPVAL))="" Q
..I ORPVAL="pnumImmSite" D Q
...S $P(LST(TOPLST),U,ORPRMPTS(ORPVAL))=$P(ORDATA(SUB),U,3)_";"_$P(ORDATA(SUB),U,2)_";"_$P(ORDATA(SUB),U)
..I SUB'="CODES" S $P(LST(TOPLST),U,ORPRMPTS(ORPVAL))=$TR(ORDATA(SUB),U,";")
SKT ;for skin test:
; LST(n)="SK"^Code^^^result^prv^reading^d/t read^d/t given
S ISK=0 F S ISK=$O(^TMP("PXKENC",$J,VISIT,"SK",ISK)) Q:'ISK D
.K ORDATA D VSKIN^PXPXRM(ISK,.ORDATA)
.S ILST=ILST+1,TOPLST=ILST
.S LST(TOPLST)="SK"_U
.S SUB="" F S SUB=$O(ORDATA(SUB)) Q:SUB="" D
..I SUB="VISIT DATE TIME" Q
..S ORPVAL=$G(ORPARR(SUB)) I ORPVAL="" Q
..I +ORPVAL>0 D Q
...I ORPVAL=4 S $P(LST(TOPLST),U,4)=$P($G(ORDATA(SUB)),U,2),$P(LST(TOPLST),U,2)=+ORDATA(SUB) Q
...S $P(LST(TOPLST),U,ORPVAL)=$TR(ORDATA(SUB),U,";")
..I ORPVAL="pnumComment" D Q
...I $G(ORDATA(SUB))="" Q
...S ICOM=ICOM+1
...S CPIECE=10
...I SUB="READING COMMENTS" S CPIECE=14
...S $P(LST(TOPLST),U,CPIECE)=ICOM
...S ILST=ILST+1,LST(ILST)="COM"_U_ICOM_U_ORDATA(SUB)
..I $G(ORPRMPTS(ORPVAL))="" Q
..I ORPVAL="SK_RES" D Q
...S $P(LST(TOPLST),U,ORPRMPTS(ORPVAL))=$S($G(ORDATA(SUB))="D":"Doubtful",$G(ORDATA(SUB))="N":"Negative",$G(ORDATA("SUB"))="P":"Postive",1:"")
..I ORPVAL="pnumImmSite" D Q
...S $P(LST(TOPLST),U,ORPRMPTS(ORPVAL))=$P(ORDATA(SUB),U,3)_";"_$P(ORDATA(SUB),U,2)_";"_$P(ORDATA(SUB),U)
..S $P(LST(TOPLST),U,ORPRMPTS(ORPVAL))=$TR(ORDATA(SUB),U,";")
;for patient education:
; LST(n)="PED"^Code^^^level of understanding^prv
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)),X220=$G(^(220)),X811=$G(^(811))
. S CODE=$P(X0,U)
. S:CODE NARR=$P(^AUTTEDT(CODE,0),U)
. S MAG=$P(X220,U,1)
. S UCUM=$P(X220,U,2)
. 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_U_MAG_U_UCUM
. 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
;for health factors:
; LST(n)="HF"^Code^^^level/severity^prv
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)),X220=$G(^(220)),X811=$G(^(811))
. S CODE=$P(X0,U)
. S:CODE NARR=$P(^AUTTHF(CODE,0),U)
. S MAG=$P(X220,U,1)
. S UCUM=$P(X220,U,2)
. 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_U_MAG_U_UCUM
. 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
;for exam:
; LST(n)="XAM"^Code^^^result^prv
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)),X220=$G(^(220)),X811=$G(^(811))
. S CODE=$P(X0,U)
. S:CODE NARR=$P(^AUTTEXAM(CODE,0),U)
. S MAG=$P(X220,U,1)
. S UCUM=$P(X220,U,2)
. 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_MAG_U_UCUM ;$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
;for Standard Codes:
; LST(n)="SC"^Code^^Narritive^Coding System^prv^Mag^UCUM
S IST=0 F S IST=$O(^TMP("PXKENC",$J,VISIT,"SC",IST)) Q:'IST D
. S X0=^TMP("PXKENC",$J,VISIT,"SC",IST,0),X12=$G(^(12)),X220=$G(^(220)),X811=$G(^(811))
. S CODE=$P(X0,U)
. S SYSIEN=$P($$CSYS^LEXU($P(X0,U,5)),U,1)
. I CODE S NARR=$P($$EXP^LEXCODE(CODE,SYSIEN,$P(VSTR,";",2)),U,2) ;S NARR=$P($G(^AUPNVSC(CODE,0)),U)
. S MAG=$P(X220,U,1)
. S UCUM=$P(X220,U,2)
. S CAT=$P(X0,U,5)
. S PRV=$P(X12,U,4)
. S ILST=ILST+1
. S LST(ILST)="SC"_U_CODE_U_U_NARR_U_CAT_U_PRV_U_MAG_U_UCUM
. 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
;for treatment:
; LST(n)="TRT"^Code^CAT^NARR^QTY^prv
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
GETFIND ;
D GETFIND^PXRMRPCG(.GFINDS,DFN,VISIT,$G(IEN))
S GCNT=0 F S GCNT=$O(GFINDS(GCNT)) Q:GCNT'>0 D
.S ILST=ILST+1
.S LST(ILST)=GFINDS(GCNT)
Q
GETDXTXT(ORY,NARR,CODE) ; RPC to resolve Dx Text for PCE view
S ORY=$$SETNARR(NARR,CODE)
Q
SETNARR(NARR,CODE) ; Set narrative string
N I,PRIMCODE,ICDLBL
I (NARR?1.N),($P($G(^AUTNPOV(+NARR,0)),U)]"") S NARR=$P($G(^AUTNPOV(+NARR,0)),U)
;S:(ICDD]"")&($$UP^XLFSTR(NARR)'[$$UP^XLFSTR(ICDD)) NARR=$P(NARR," (")_" - "_ICDD_" - "_$S(NARR[" (":" (",1:"")_$P(NARR," (",2)
;S:NARR'[CODE NARR=$S(NARR["(SCT":$P(NARR,")")_", ",1:NARR_" (")_"ICD-9-CM "_CODE_")"
I NARR["(SNOMED CT" S NARR=$P(NARR,"(")_"(SCT"_$P($P(NARR,")"),"(SNOMED CT",2)_")"
E I NARR["SNOMED CT" S NARR=$P(NARR,"SNOMED CT")_"(SCT"_$P($P(NARR,":"),"SNOMED CT",2)_")"
S PRIMCODE=$S(CODE["/":$P(CODE,"/"),1:CODE),ICDLBL=$P($$CODECS^ICDEX(PRIMCODE,80,DT),U,2)
I CODE["/" F I=1:1:$L(CODE,"/") D
. N ICDC,ICDD S ICDC=$P(CODE,"/",I),ICDD=$$ICDDESC(ICDC)
. I (NARR'[ICDC)&((ICDD]"")&($$UP^XLFSTR(NARR)'=$$UP^XLFSTR(ICDD))) S NARR=NARR_" - "_ICDD_" ("_$G(ICDLBL)_" "_ICDC_")"
. E S:NARR'[ICDC NARR=NARR_" ("_$G(ICDLBL)_" "_ICDC_")"
E D
. N ICDD S ICDD=$$ICDDESC(CODE)
. I (NARR'[CODE)&((ICDD]"")&($$UP^XLFSTR(NARR)'=$$UP^XLFSTR(ICDD))) S NARR=NARR_" - "_ICDD_" ("_$G(ICDLBL)_" "_CODE_")"
. E S:NARR'[CODE NARR=NARR_" ("_$G(ICDLBL)_" "_CODE_")"
Q NARR
ICDDESC(ORCODE,ORDT) ; Get description for ICD9 Code
N ICDD,ORY S ORY="",ORDT=$G(ORDT,DT)
D ICDDESC^ICDXCODE("DIAGNOSIS",ORCODE,ORDT,.ICDD)
I '$D(ICDD) G ICDDESQ
S ORY=$$SENTENCE^XLFSTR($G(ICDD(1)))
ICDDESQ Q ORY
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORWPCE3 14329 printed Dec 13, 2024@02:37:01 Page 2
ORWPCE3 ; SLC/KCM/REV/JM/TC - Get a PCE encounter for a TIU document ;Aug 22, 2023@08:55
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**10,85,116,190,280,306,371,361,385,377,498,405,598,588,606**;Dec 17, 1997;Build 3
+2 ;
+3 ; Reference to ENCEVENT^PXAPI in ICR #1894
+4 ; Reference to $$ICDDATA^ICDXCODE in ICR #5747
+5 ; Reference to VSKIN^PXPXRM in ICR #4250
+6 ; Reference to VIMM^PXPXRM in ICR #4250
+7 ; Reference to VICR^PXPXRM in ICR #4250
+8 ; Reference to ^AUTNPOV( in ICR #1593
+9 ; Reference to GETFIND^PXRMRPCG in ICR #6839
+10 ; Reference to ICDDESC^ICDXCODE in ICR #5747
+11 ; Reference to $$SENTENCE^XLFSTR in ICR #10104
+12 ; Reference to ^AUPNVSIT( in ICR #2028
+13 ; Reference to ^AUTTEDT( in ICR #1987
+14 ; Reference to ^AUTTEXAM( in ICR #1988
+15 ; Reference to ^AUTTHF( in ICR #1989
+16 ; Reference to ^TIU(8925, in ICR #2937
+17 ; Reference to $$CODECS^ICDEX in ICR #5747
+18 ; Reference to $$CSI^ICDEX in ICR #5747
+19 ; Reference to $$SAB^ICDEX in ICR #5747
+20 ;
PCE4NOTE(LST,IEN,DFN,VSITSTR) ; Return encounter for an associated note IA#4214,6132,6614
+1 ; LST(1)=HDR^AllowEdit^CPTRequired^VStr^Author^hasCPT^VisitIEN
+2 ; LST(n)=TYP+^CODE^CAT^NARR^QUAL1^QUAL2 (QUAL1=Primary!Qty, QUAL2=Prv)
+3 NEW VISIT,VSTR,ILST,OLST,LOC,LOTNODE,NODE,CODE,MANUF,ORPRMPTS,PRIM,QTY,CAT,NARR,PRV
+4 NEW X,X0,X2,X12,X13,X16,X802,X811,VTYP,IPOV,ICPT,IPRV,IIMM,ISK,IPED,IHF,IXAM,ITRT
+5 NEW ICOM,ISSECV,MIDX,MIEN,MCNT,MODS,VIS,VISCNT,VISTEMP,CPIECE,GFINDS,GCNT,ITEM,ORDATA
+6 NEW ORPARR,ORPVAL,ORSUB,TOPLST,IST,X220,MAG,UCUM,PRIMARY,SUB,TEMP,SYSTEM,SYSIEN
+7 SET PRIMARY=0
+8 ; Get PCE Data on a new note not yet saved
IF +$GET(IEN)<1
Begin DoDot:1
+9 SET (X0,X12)=""
+10 SET VSTR=$GET(VSITSTR)
+11 SET VISIT=$$GETVSIT^ORWPCE1(VSTR,$GET(DFN))
+12 IF 'VISIT
SET VISIT=-1
End DoDot:1
IF 1
+13 IF '$TEST
Begin DoDot:1
+14 SET X0=$GET(^TIU(8925,IEN,0))
SET X12=$GET(^(12))
+15 ;make sure DFN is defined for Reminder call at the end of the routine.
+16 IF +$GET(DFN)=0
SET DFN=$PIECE(X0,U,2)
+17 SET VISIT=$PIECE(X12,U,7)
SET ISSECV=1
+18 IF 'VISIT
SET VISIT=$PIECE(X0,U,3)
SET PRIMARY=1
SET ISSECV=0
+19 DO NOTEVSTR^ORWPCE(.VSTR,IEN)
+20 ;address an issue with ancillary service that is clinic being reported by PCE as a ward location
+21 IF ISSECV=0
IF $PIECE(VSTR,";",3)="D"
IF VISIT>0
Begin DoDot:2
+22 IF $PIECE($GET(^AUPNVSIT(VISIT,0)),U,7)="H"
SET VISIT=-1
SET PRIMARY=0
End DoDot:2
End DoDot:1
+23 SET VTYP=$PIECE(VSTR,";",3)
+24 SET ILST=1
+25 SET ICOM=0
+26 SET LST(1)="HDR"_U_("HID"[VTYP)_U_$PIECE(X0,U,11)_U_VSTR_U_$PIECE(X12,U,2)
+27 ;add hasCPT node
+28 SET LST(1)=LST(1)_U_0_U_VISIT_U_PRIMARY
+29 IF VISIT'>0
Begin DoDot:1
+30 ; get cached visit data
IF $GET(VSTR)'=""
MERGE LST=^TMP("ORWPCE",$JOB,VSTR)
End DoDot:1
GOTO GETFIND
+31 ; quit if admission
IF $PIECE(LST(1),U,2)
IF VTYP="H"
QUIT
+32 KILL ^TMP("PXKENC",$JOB)
+33 DO ENCEVENT^PXAPI(VISIT)
+34 DO BLDPRMPT^ORFEDT(.ORPRMPTS)
+35 DO BLDPARR^ORFEDT(.ORPARR)
+36 IF '$DATA(^TMP("PXKENC",$JOB,VISIT,"VST",VISIT,0))
GOTO GETFIND
+37 SET $PIECE(LST(1),U,6)=$DATA(^TMP("PXKENC",$JOB,VISIT,"CPT"))\10
+38 SET X0=^TMP("PXKENC",$JOB,VISIT,"VST",VISIT,0)
SET LOC=+$PIECE(X0,U,22)
+39 SET ILST=ILST+1
SET LST(ILST)="VST^DT^"_$PIECE(X0,U)
+40 SET ILST=ILST+1
SET LST(ILST)="VST^PT^"_$PIECE(X0,U,5)
+41 SET ILST=ILST+1
SET LST(ILST)="VST^HL^"_LOC_"^^"_$PIECE($GET(^SC(LOC,0)),U)
+42 ;outpt
SET ILST=ILST+1
SET LST(ILST)="VST^PS^0"
+43 ;S X0=$G(^TMP("PXKENC",$J,VISIT,"VST",VISIT,800))
+44 NEW VAL,SCNODE
+45 SET SCNODE=$GET(^TMP("PXKENC",$JOB,VISIT,"VST",VISIT,800))
+46 ;D SCSEL^ORWPCE(.VAL,$P(X0,U,5),$P(X0,U),LOC,VISIT)
+47 ;S ILST=ILST+1,LST(ILST)="VST^SC^"_$P($P(VAL,";",1),U,2)
+48 SET ILST=ILST+1
SET LST(ILST)="VST^SC^"_$PIECE(SCNODE,U)
+49 ;S ILST=ILST+1,LST(ILST)="VST^AO^"_$P($P(VAL,";",2),U,2)
+50 SET ILST=ILST+1
SET LST(ILST)="VST^AO^"_$PIECE(SCNODE,U,2)
+51 ;S ILST=ILST+1,LST(ILST)="VST^IR^"_$P($P(VAL,";",3),U,2)
+52 SET ILST=ILST+1
SET LST(ILST)="VST^IR^"_$PIECE(SCNODE,U,3)
+53 ;S ILST=ILST+1,LST(ILST)="VST^EC^"_$P($P(VAL,";",4),U,2)
+54 SET ILST=ILST+1
SET LST(ILST)="VST^EC^"_$PIECE(SCNODE,U,4)
+55 ;S ILST=ILST+1,LST(ILST)="VST^MST^"_$P($P(VAL,";",5),U,2)
+56 SET ILST=ILST+1
SET LST(ILST)="VST^MST^"_$PIECE(SCNODE,U,5)
+57 ;I $P(VAL,";",6)'="" D
+58 ;.S ILST=ILST+1,LST(ILST)="VST^HNC^"_$P($P(VAL,";",6),U,2)
+59 SET ILST=ILST+1
SET LST(ILST)="VST^HNC^"_$PIECE(SCNODE,U,6)
+60 ;I $P(VAL,";",7)'="" D
+61 ;.S ILST=ILST+1,LST(ILST)="VST^CV^"_$P($P(VAL,";",7),U,2)
+62 SET ILST=ILST+1
SET LST(ILST)="VST^CV^"_$PIECE(SCNODE,U,7)
+63 ;I $P(VAL,";",8)'="" D
+64 ;.S ILST=ILST+1,LST(ILST)="VST^SHAD^"_$P($P(VAL,";",8),U,2)
+65 SET ILST=ILST+1
SET LST(ILST)="VST^SHAD^"_$PIECE(SCNODE,U,8)
+66 ;for provider
+67 ; LST(n)="PRV"^ien^^^name^primary/secondary flag
+68 SET IPRV=0
FOR
SET IPRV=$ORDER(^TMP("PXKENC",$JOB,VISIT,"PRV",IPRV))
if 'IPRV
QUIT
Begin DoDot:1
+69 SET X0=^TMP("PXKENC",$JOB,VISIT,"PRV",IPRV,0)
+70 ;Q:$P(X0,U,4)'="P"
+71 SET CODE=$PIECE(X0,U)
SET NARR=$PIECE($GET(^VA(200,CODE,0)),U)
+72 SET PRIM=($PIECE(X0,U,4)="P")
+73 SET ILST=ILST+1
+74 SET LST(ILST)="PRV"_U_CODE_"^^^"_NARR_"^"_PRIM
End DoDot:1
+75 SET IPOV=0
FOR
SET IPOV=$ORDER(^TMP("PXKENC",$JOB,VISIT,"POV",IPOV))
if 'IPOV
QUIT
Begin DoDot:1
+76 NEW ICDCSYS
+77 SET X0=^TMP("PXKENC",$JOB,VISIT,"POV",IPOV,0)
SET X802=$GET(^(802))
SET X811=$GET(^(811))
+78 SET CODE=$PIECE(X0,U)
SET NARR=$PIECE(X0,U,4)
SET ICDCSYS=$$SAB^ICDEX($$CSI^ICDEX(80,CODE),DT)
+79 IF CODE
Begin DoDot:2
+80 SET CODE=$PIECE($$ICDDATA^ICDXCODE(ICDCSYS,CODE,DT),U,2)
+81 SET NARR=$$SETNARR(NARR,CODE)
End DoDot:2
+82 SET CAT=$PIECE(X802,U)
+83 if CAT
SET CAT=$PIECE(^AUTNPOV(CAT,0),U)
+84 SET PRIM=($PIECE(X0,U,12)="P")
+85 SET PRV=$PIECE(X12,U,4)
+86 SET ILST=ILST+1
+87 SET LST(ILST)="POV"_U_CODE_U_CAT_U_NARR_U_PRIM_U_PRV
+88 IF X811]""
Begin DoDot:2
+89 SET ICOM=ICOM+1
+90 SET $PIECE(LST(ILST),U,10)=ICOM
+91 SET ILST=ILST+1
+92 SET LST(ILST)="COM"_U_ICOM_U_X811
End DoDot:2
End DoDot:1
+93 SET ICPT=0
FOR
SET ICPT=$ORDER(^TMP("PXKENC",$JOB,VISIT,"CPT",ICPT))
if 'ICPT
QUIT
Begin DoDot:1
+94 SET X0=^TMP("PXKENC",$JOB,VISIT,"CPT",ICPT,0)
SET X802=$GET(^(802))
SET X12=$GET(^(12))
SET X811=$GET(^(811))
+95 ;ICR #1995
SET CODE=$$CODEC^ICPTCOD($PIECE(X0,U))
+96 if CODE=-1
SET CODE=""
+97 SET CAT=$PIECE(X802,U)
+98 if CAT
SET CAT=$PIECE(^AUTNPOV(CAT,0),U)
+99 SET NARR=$PIECE(X0,U,4)
+100 if NARR
SET NARR=$PIECE(^AUTNPOV(NARR,0),U)
+101 SET QTY=$PIECE(X0,U,16)
+102 SET PRV=$PIECE(X12,U,4)
+103 SET MCNT=0
SET MIDX=0
SET MODS=""
+104 FOR
SET MIDX=$ORDER(^TMP("PXKENC",$JOB,VISIT,"CPT",ICPT,1,MIDX))
if 'MIDX
QUIT
Begin DoDot:2
+105 SET MIEN=$GET(^TMP("PXKENC",$JOB,VISIT,"CPT",ICPT,1,MIDX,0))
+106 IF +MIEN
SET MCNT=MCNT+1
SET MODS=MODS_";/"_MIEN
End DoDot:2
+107 IF +MCNT
SET MODS=MCNT_MODS
+108 SET ILST=ILST+1
+109 SET LST(ILST)="CPT"_U_CODE_U_CAT_U_NARR_U_QTY_U_PRV_U_U_U_MODS
+110 IF X811]""
Begin DoDot:2
+111 SET ICOM=ICOM+1
+112 SET $PIECE(LST(ILST),U,10)=ICOM
+113 SET ILST=ILST+1
+114 SET LST(ILST)="COM"_U_ICOM_U_X811
End DoDot:2
End DoDot:1
ICR ;for contraindicated/refused:
+1 SET ITEM=0
FOR
SET ITEM=$ORDER(^TMP("PXKENC",$JOB,VISIT,"ICR",ITEM))
if ITEM'>0
QUIT
Begin DoDot:1
+2 KILL ORDATA
DO VICR^PXPXRM(ITEM,.ORDATA)
+3 SET ILST=ILST+1
SET TOPLST=ILST
+4 SET SUB=""
FOR
SET SUB=$ORDER(ORDATA(SUB))
if SUB=""
QUIT
Begin DoDot:2
+5 IF ORDATA(SUB)=""
QUIT
+6 IF ORDATA(SUB)=U
QUIT
+7 IF SUB="REFUSED VACCINE GROUP"
Begin DoDot:3
+8 SET TEMP=ORDATA(SUB)
+9 SET $PIECE(LST(TOPLST),U,ORPRMPTS("pnumRefusedGroup"))='TEMP
End DoDot:3
QUIT
+10 SET ORPVAL=$GET(ORPARR(SUB))
IF ORPVAL=""
QUIT
+11 IF ORPVAL>0
Begin DoDot:3
+12 IF ORPVAL=4
SET $PIECE(LST(TOPLST),U)="IMM"
SET $PIECE(LST(TOPLST),U,2)=+ORDATA(SUB)
SET $PIECE(LST(TOPLST),U,4)=$PIECE(ORDATA(SUB),U,2)
QUIT
+13 SET $PIECE(LST(TOPLST),U,ORPVAL)=$GET(ORDATA(SUB))
End DoDot:3
QUIT
+14 IF ORPVAL="CONTRA"
Begin DoDot:3
+15 SET TEMP=ORDATA(SUB)
+16 IF TEMP[920.4
SET $PIECE(LST(TOPLST),U,ORPRMPTS("pnumImmContra"))=$TRANSLATE(TEMP,U,":")
QUIT
+17 SET $PIECE(LST(TOPLST),U,ORPRMPTS("pnumImmRefused"))=$TRANSLATE(TEMP,U,":")
End DoDot:3
QUIT
+18 IF ORPVAL="COMMENT"
IF $GET(ORDATA(SUB))'=""
Begin DoDot:3
+19 SET ICOM=ICOM+1
+20 SET $PIECE(LST(TOPLST),U,10)=ICOM
+21 SET ILST=ILST+1
SET LST(ILST)="COM"_U_ICOM_U_ORDATA(SUB)
End DoDot:3
QUIT
+22 SET $PIECE(LST(TOPLST),U,ORPRMPTS(ORPVAL))=$TRANSLATE(ORDATA(SUB),U,";")
End DoDot:2
End DoDot:1
IMM ;for immunization:
+1 ; LST(n)="IMM"^Code^^^Series^prv^Reaction^Contraindicated^Refused
+2 SET IIMM=0
FOR
SET IIMM=$ORDER(^TMP("PXKENC",$JOB,VISIT,"IMM",IIMM))
if 'IIMM
QUIT
Begin DoDot:1
+3 KILL ORDATA
DO VIMM^PXPXRM(IIMM,.ORDATA)
+4 SET ILST=ILST+1
SET TOPLST=ILST
+5 SET LST(TOPLST)="IMM"_U
+6 SET SUB=""
FOR
SET SUB=$ORDER(ORDATA(SUB))
if SUB=""
QUIT
Begin DoDot:2
+7 IF SUB="VISIT DATE TIME"
QUIT
+8 SET ORPVAL=$GET(ORPARR(SUB))
IF ORPVAL=""
QUIT
+9 IF +ORPVAL>0
Begin DoDot:3
+10 IF ORPVAL=4
SET $PIECE(LST(TOPLST),U,4)=$PIECE($GET(ORDATA(SUB)),U,2)
SET $PIECE(LST(TOPLST),U,2)=+ORDATA(SUB)
QUIT
+11 SET $PIECE(LST(TOPLST),U,ORPVAL)=$GET(ORDATA(SUB))
End DoDot:3
QUIT
+12 IF ORPVAL="pnumComment"
Begin DoDot:3
+13 IF $GET(ORDATA(SUB))'=""
Begin DoDot:4
+14 SET ICOM=ICOM+1
+15 SET $PIECE(LST(TOPLST),U,10)=ICOM
+16 SET ILST=ILST+1
SET LST(ILST)="COM"_U_ICOM_U_ORDATA(SUB)
End DoDot:4
End DoDot:3
QUIT
+17 IF ORPVAL="pnumImmOverride"
IF $GET(ORDATA(SUB))'=""
Begin DoDot:3
+18 SET ICOM=ICOM+1
+19 SET $PIECE(LST(TOPLST),U,24)=ICOM
+20 SET ILST=ILST+1
SET LST(ILST)="COM"_U_ICOM_U_ORDATA(SUB)
End DoDot:3
QUIT
+21 IF ORPVAL="pnumIMMVIS"
Begin DoDot:3
+22 SET VIS=""
+23 SET VISCNT=0
FOR
SET VISCNT=$ORDER(ORDATA(SUB,VISCNT))
if VISCNT'>0
QUIT
Begin DoDot:4
+24 SET VISTEMP=$TRANSLATE($PIECE(ORDATA(SUB,VISCNT,0),U,1,2),U,"/")
+25 IF VIS'=""
SET VIS=VISTEMP_";"_VISTEMP
QUIT
+26 SET VIS=VISTEMP
End DoDot:4
+27 IF VIS'=""
SET $PIECE(LST(TOPLST),U,21)=VIS
End DoDot:3
QUIT
+28 IF $GET(ORPRMPTS(ORPVAL))=""
QUIT
+29 IF ORPVAL="pnumImmSite"
Begin DoDot:3
+30 SET $PIECE(LST(TOPLST),U,ORPRMPTS(ORPVAL))=$PIECE(ORDATA(SUB),U,3)_";"_$PIECE(ORDATA(SUB),U,2)_";"_$PIECE(ORDATA(SUB),U)
End DoDot:3
QUIT
+31 IF SUB'="CODES"
SET $PIECE(LST(TOPLST),U,ORPRMPTS(ORPVAL))=$TRANSLATE(ORDATA(SUB),U,";")
End DoDot:2
End DoDot:1
SKT ;for skin test:
+1 ; LST(n)="SK"^Code^^^result^prv^reading^d/t read^d/t given
+2 SET ISK=0
FOR
SET ISK=$ORDER(^TMP("PXKENC",$JOB,VISIT,"SK",ISK))
if 'ISK
QUIT
Begin DoDot:1
+3 KILL ORDATA
DO VSKIN^PXPXRM(ISK,.ORDATA)
+4 SET ILST=ILST+1
SET TOPLST=ILST
+5 SET LST(TOPLST)="SK"_U
+6 SET SUB=""
FOR
SET SUB=$ORDER(ORDATA(SUB))
if SUB=""
QUIT
Begin DoDot:2
+7 IF SUB="VISIT DATE TIME"
QUIT
+8 SET ORPVAL=$GET(ORPARR(SUB))
IF ORPVAL=""
QUIT
+9 IF +ORPVAL>0
Begin DoDot:3
+10 IF ORPVAL=4
SET $PIECE(LST(TOPLST),U,4)=$PIECE($GET(ORDATA(SUB)),U,2)
SET $PIECE(LST(TOPLST),U,2)=+ORDATA(SUB)
QUIT
+11 SET $PIECE(LST(TOPLST),U,ORPVAL)=$TRANSLATE(ORDATA(SUB),U,";")
End DoDot:3
QUIT
+12 IF ORPVAL="pnumComment"
Begin DoDot:3
+13 IF $GET(ORDATA(SUB))=""
QUIT
+14 SET ICOM=ICOM+1
+15 SET CPIECE=10
+16 IF SUB="READING COMMENTS"
SET CPIECE=14
+17 SET $PIECE(LST(TOPLST),U,CPIECE)=ICOM
+18 SET ILST=ILST+1
SET LST(ILST)="COM"_U_ICOM_U_ORDATA(SUB)
End DoDot:3
QUIT
+19 IF $GET(ORPRMPTS(ORPVAL))=""
QUIT
+20 IF ORPVAL="SK_RES"
Begin DoDot:3
+21 SET $PIECE(LST(TOPLST),U,ORPRMPTS(ORPVAL))=$SELECT($GET(ORDATA(SUB))="D":"Doubtful",$GET(ORDATA(SUB))="N":"Negative",$GET(ORDATA("SUB"))="P":"Postive",1:"")
End DoDot:3
QUIT
+22 IF ORPVAL="pnumImmSite"
Begin DoDot:3
+23 SET $PIECE(LST(TOPLST),U,ORPRMPTS(ORPVAL))=$PIECE(ORDATA(SUB),U,3)_";"_$PIECE(ORDATA(SUB),U,2)_";"_$PIECE(ORDATA(SUB),U)
End DoDot:3
QUIT
+24 SET $PIECE(LST(TOPLST),U,ORPRMPTS(ORPVAL))=$TRANSLATE(ORDATA(SUB),U,";")
End DoDot:2
End DoDot:1
+25 ;for patient education:
+26 ; LST(n)="PED"^Code^^^level of understanding^prv
+27 SET IPED=0
FOR
SET IPED=$ORDER(^TMP("PXKENC",$JOB,VISIT,"PED",IPED))
if 'IPED
QUIT
Begin DoDot:1
+28 SET X0=^TMP("PXKENC",$JOB,VISIT,"PED",IPED,0)
SET X12=$GET(^(12))
SET X220=$GET(^(220))
SET X811=$GET(^(811))
+29 SET CODE=$PIECE(X0,U)
+30 if CODE
SET NARR=$PIECE(^AUTTEDT(CODE,0),U)
+31 SET MAG=$PIECE(X220,U,1)
+32 SET UCUM=$PIECE(X220,U,2)
+33 SET QTY=$PIECE(X0,U,6)
+34 SET CAT=""
+35 SET PRV=$PIECE(X12,U,4)
+36 SET ILST=ILST+1
+37 SET LST(ILST)="PED"_U_CODE_U_CAT_U_NARR_U_QTY_U_PRV_U_MAG_U_UCUM
+38 IF X811]""
Begin DoDot:2
+39 SET ICOM=ICOM+1
+40 SET $PIECE(LST(ILST),U,10)=ICOM
+41 SET ILST=ILST+1
+42 SET LST(ILST)="COM"_U_ICOM_U_X811
End DoDot:2
End DoDot:1
+43 ;for health factors:
+44 ; LST(n)="HF"^Code^^^level/severity^prv
+45 SET IHF=0
FOR
SET IHF=$ORDER(^TMP("PXKENC",$JOB,VISIT,"HF",IHF))
if 'IHF
QUIT
Begin DoDot:1
+46 SET X0=^TMP("PXKENC",$JOB,VISIT,"HF",IHF,0)
SET X12=$GET(^(12))
SET X220=$GET(^(220))
SET X811=$GET(^(811))
+47 SET CODE=$PIECE(X0,U)
+48 if CODE
SET NARR=$PIECE(^AUTTHF(CODE,0),U)
+49 SET MAG=$PIECE(X220,U,1)
+50 SET UCUM=$PIECE(X220,U,2)
+51 SET QTY=$PIECE(X0,U,4)
+52 SET CAT=""
+53 SET PRV=$PIECE(X12,U,4)
+54 SET ILST=ILST+1
+55 SET LST(ILST)="HF"_U_CODE_U_CAT_U_NARR_U_QTY_U_PRV_U_MAG_U_UCUM
+56 IF X811]""
Begin DoDot:2
+57 SET ICOM=ICOM+1
+58 SET $PIECE(LST(ILST),U,10)=ICOM
+59 SET ILST=ILST+1
+60 SET LST(ILST)="COM"_U_ICOM_U_X811
End DoDot:2
End DoDot:1
+61 ;for exam:
+62 ; LST(n)="XAM"^Code^^^result^prv
+63 SET IXAM=0
FOR
SET IXAM=$ORDER(^TMP("PXKENC",$JOB,VISIT,"XAM",IXAM))
if 'IXAM
QUIT
Begin DoDot:1
+64 SET X0=^TMP("PXKENC",$JOB,VISIT,"XAM",IXAM,0)
SET X12=$GET(^(12))
SET X220=$GET(^(220))
SET X811=$GET(^(811))
+65 SET CODE=$PIECE(X0,U)
+66 if CODE
SET NARR=$PIECE(^AUTTEXAM(CODE,0),U)
+67 SET MAG=$PIECE(X220,U,1)
+68 SET UCUM=$PIECE(X220,U,2)
+69 SET QTY=$PIECE(X0,U,4)
+70 SET CAT=""
+71 SET PRV=$PIECE(X12,U,4)
+72 SET ILST=ILST+1
+73 ;$P(X0,U,6,7)
SET LST(ILST)="XAM"_U_CODE_U_CAT_U_NARR_U_QTY_U_PRV_U_MAG_U_UCUM
+74 IF X811]""
Begin DoDot:2
+75 SET ICOM=ICOM+1
+76 SET $PIECE(LST(ILST),U,10)=ICOM
+77 SET ILST=ILST+1
+78 SET LST(ILST)="COM"_U_ICOM_U_X811
End DoDot:2
End DoDot:1
+79 ;for Standard Codes:
+80 ; LST(n)="SC"^Code^^Narritive^Coding System^prv^Mag^UCUM
+81 SET IST=0
FOR
SET IST=$ORDER(^TMP("PXKENC",$JOB,VISIT,"SC",IST))
if 'IST
QUIT
Begin DoDot:1
+82 SET X0=^TMP("PXKENC",$JOB,VISIT,"SC",IST,0)
SET X12=$GET(^(12))
SET X220=$GET(^(220))
SET X811=$GET(^(811))
+83 SET CODE=$PIECE(X0,U)
+84 SET SYSIEN=$PIECE($$CSYS^LEXU($PIECE(X0,U,5)),U,1)
+85 ;S NARR=$P($G(^AUPNVSC(CODE,0)),U)
IF CODE
SET NARR=$PIECE($$EXP^LEXCODE(CODE,SYSIEN,$PIECE(VSTR,";",2)),U,2)
+86 SET MAG=$PIECE(X220,U,1)
+87 SET UCUM=$PIECE(X220,U,2)
+88 SET CAT=$PIECE(X0,U,5)
+89 SET PRV=$PIECE(X12,U,4)
+90 SET ILST=ILST+1
+91 SET LST(ILST)="SC"_U_CODE_U_U_NARR_U_CAT_U_PRV_U_MAG_U_UCUM
+92 IF X811]""
Begin DoDot:2
+93 SET ICOM=ICOM+1
+94 SET $PIECE(LST(ILST),U,10)=ICOM
+95 SET ILST=ILST+1
+96 SET LST(ILST)="COM"_U_ICOM_U_X811
End DoDot:2
End DoDot:1
+97 ;for treatment:
+98 ; LST(n)="TRT"^Code^CAT^NARR^QTY^prv
+99 SET ITRT=0
FOR
SET ITRT=$ORDER(^TMP("PXKENC",$JOB,VISIT,"TRT",ITRT))
if 'ITRT
QUIT
Begin DoDot:1
+100 SET X0=^TMP("PXKENC",$JOB,VISIT,"TRT",ITRT,0)
SET X802=$GET(^(802))
SET X12=$GET(^(12))
SET X811=$GET(^(811))
+101 SET CODE=$PIECE(X0,U)
+102 SET QTY=$PIECE(X0,U,4)
+103 SET CAT=$PIECE(X802,U)
+104 SET NARR=$PIECE(X0,U,6)
+105 if CAT
SET CAT=$PIECE(^AUTNPOV(CAT,0),U)
+106 if NARR
SET NARR=$PIECE(^AUTNPOV(NARR,0),U)
+107 SET PRV=$PIECE(X12,U,4)
+108 SET ILST=ILST+1
+109 SET LST(ILST)="TRT"_U_CODE_U_CAT_U_NARR_U_QTY_U_PRV
+110 IF X811]""
Begin DoDot:2
+111 SET ICOM=ICOM+1
+112 SET $PIECE(LST(ILST),U,10)=ICOM
+113 SET ILST=ILST+1
+114 SET LST(ILST)="COM"_U_ICOM_U_X811
End DoDot:2
End DoDot:1
GETFIND ;
+1 DO GETFIND^PXRMRPCG(.GFINDS,DFN,VISIT,$GET(IEN))
+2 SET GCNT=0
FOR
SET GCNT=$ORDER(GFINDS(GCNT))
if GCNT'>0
QUIT
Begin DoDot:1
+3 SET ILST=ILST+1
+4 SET LST(ILST)=GFINDS(GCNT)
End DoDot:1
+5 QUIT
GETDXTXT(ORY,NARR,CODE) ; RPC to resolve Dx Text for PCE view
+1 SET ORY=$$SETNARR(NARR,CODE)
+2 QUIT
SETNARR(NARR,CODE) ; Set narrative string
+1 NEW I,PRIMCODE,ICDLBL
+2 IF (NARR?1.N)
IF ($PIECE($GET(^AUTNPOV(+NARR,0)),U)]"")
SET NARR=$PIECE($GET(^AUTNPOV(+NARR,0)),U)
+3 ;S:(ICDD]"")&($$UP^XLFSTR(NARR)'[$$UP^XLFSTR(ICDD)) NARR=$P(NARR," (")_" - "_ICDD_" - "_$S(NARR[" (":" (",1:"")_$P(NARR," (",2)
+4 ;S:NARR'[CODE NARR=$S(NARR["(SCT":$P(NARR,")")_", ",1:NARR_" (")_"ICD-9-CM "_CODE_")"
+5 IF NARR["(SNOMED CT"
SET NARR=$PIECE(NARR,"(")_"(SCT"_$PIECE($PIECE(NARR,")"),"(SNOMED CT",2)_")"
+6 IF '$TEST
IF NARR["SNOMED CT"
SET NARR=$PIECE(NARR,"SNOMED CT")_"(SCT"_$PIECE($PIECE(NARR,":"),"SNOMED CT",2)_")"
+7 SET PRIMCODE=$SELECT(CODE["/":$PIECE(CODE,"/"),1:CODE)
SET ICDLBL=$PIECE($$CODECS^ICDEX(PRIMCODE,80,DT),U,2)
+8 IF CODE["/"
FOR I=1:1:$LENGTH(CODE,"/")
Begin DoDot:1
+9 NEW ICDC,ICDD
SET ICDC=$PIECE(CODE,"/",I)
SET ICDD=$$ICDDESC(ICDC)
+10 IF (NARR'[ICDC)&((ICDD]"")&($$UP^XLFSTR(NARR)'=$$UP^XLFSTR(ICDD)))
SET NARR=NARR_" - "_ICDD_" ("_$GET(ICDLBL)_" "_ICDC_")"
+11 IF '$TEST
if NARR'[ICDC
SET NARR=NARR_" ("_$GET(ICDLBL)_" "_ICDC_")"
End DoDot:1
+12 IF '$TEST
Begin DoDot:1
+13 NEW ICDD
SET ICDD=$$ICDDESC(CODE)
+14 IF (NARR'[CODE)&((ICDD]"")&($$UP^XLFSTR(NARR)'=$$UP^XLFSTR(ICDD)))
SET NARR=NARR_" - "_ICDD_" ("_$GET(ICDLBL)_" "_CODE_")"
+15 IF '$TEST
if NARR'[CODE
SET NARR=NARR_" ("_$GET(ICDLBL)_" "_CODE_")"
End DoDot:1
+16 QUIT NARR
ICDDESC(ORCODE,ORDT) ; Get description for ICD9 Code
+1 NEW ICDD,ORY
SET ORY=""
SET ORDT=$GET(ORDT,DT)
+2 DO ICDDESC^ICDXCODE("DIAGNOSIS",ORCODE,ORDT,.ICDD)
+3 IF '$DATA(ICDD)
GOTO ICDDESQ
+4 SET ORY=$$SENTENCE^XLFSTR($GET(ICDD(1)))
ICDDESQ QUIT ORY
