- 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 Feb 19, 2025@00:03:33 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