Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ORWPCE3

ORWPCE3.m

Go to the documentation of this file.
  1. 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
  1. ;
  1. ; Reference to ENCEVENT^PXAPI in ICR #1894
  1. ; Reference to $$ICDDATA^ICDXCODE in ICR #5747
  1. ; Reference to VSKIN^PXPXRM in ICR #4250
  1. ; Reference to VIMM^PXPXRM in ICR #4250
  1. ; Reference to VICR^PXPXRM in ICR #4250
  1. ; Reference to ^AUTNPOV( in ICR #1593
  1. ; Reference to GETFIND^PXRMRPCG in ICR #6839
  1. ; Reference to ICDDESC^ICDXCODE in ICR #5747
  1. ; Reference to $$SENTENCE^XLFSTR in ICR #10104
  1. ; Reference to ^AUPNVSIT( in ICR #2028
  1. ; Reference to ^AUTTEDT( in ICR #1987
  1. ; Reference to ^AUTTEXAM( in ICR #1988
  1. ; Reference to ^AUTTHF( in ICR #1989
  1. ; Reference to ^TIU(8925, in ICR #2937
  1. ; Reference to $$CODECS^ICDEX in ICR #5747
  1. ; Reference to $$CSI^ICDEX in ICR #5747
  1. ; Reference to $$SAB^ICDEX in ICR #5747
  1. ;
  1. 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
  1. ; LST(n)=TYP+^CODE^CAT^NARR^QUAL1^QUAL2 (QUAL1=Primary!Qty, QUAL2=Prv)
  1. N VISIT,VSTR,ILST,OLST,LOC,LOTNODE,NODE,CODE,MANUF,ORPRMPTS,PRIM,QTY,CAT,NARR,PRV
  1. N X,X0,X2,X12,X13,X16,X802,X811,VTYP,IPOV,ICPT,IPRV,IIMM,ISK,IPED,IHF,IXAM,ITRT
  1. N ICOM,ISSECV,MIDX,MIEN,MCNT,MODS,VIS,VISCNT,VISTEMP,CPIECE,GFINDS,GCNT,ITEM,ORDATA
  1. N ORPARR,ORPVAL,ORSUB,TOPLST,IST,X220,MAG,UCUM,PRIMARY,SUB,TEMP,SYSTEM,SYSIEN
  1. S PRIMARY=0
  1. I +$G(IEN)<1 D I 1 ; Get PCE Data on a new note not yet saved
  1. . S (X0,X12)=""
  1. . S VSTR=$G(VSITSTR)
  1. . S VISIT=$$GETVSIT^ORWPCE1(VSTR,$G(DFN))
  1. . I 'VISIT S VISIT=-1
  1. E D
  1. . S X0=$G(^TIU(8925,IEN,0)),X12=$G(^(12))
  1. . ;make sure DFN is defined for Reminder call at the end of the routine.
  1. . I +$G(DFN)=0 S DFN=$P(X0,U,2)
  1. . S VISIT=$P(X12,U,7),ISSECV=1
  1. . I 'VISIT S VISIT=$P(X0,U,3),PRIMARY=1,ISSECV=0
  1. . D NOTEVSTR^ORWPCE(.VSTR,IEN)
  1. . ;address an issue with ancillary service that is clinic being reported by PCE as a ward location
  1. . I ISSECV=0,$P(VSTR,";",3)="D",VISIT>0 D
  1. . . I $P($G(^AUPNVSIT(VISIT,0)),U,7)="H" S VISIT=-1,PRIMARY=0
  1. S VTYP=$P(VSTR,";",3)
  1. S ILST=1
  1. S ICOM=0
  1. S LST(1)="HDR"_U_("HID"[VTYP)_U_$P(X0,U,11)_U_VSTR_U_$P(X12,U,2)
  1. ;add hasCPT node
  1. S LST(1)=LST(1)_U_0_U_VISIT_U_PRIMARY
  1. I VISIT'>0 D G GETFIND
  1. . I $G(VSTR)'="" M LST=^TMP("ORWPCE",$J,VSTR) ; get cached visit data
  1. I $P(LST(1),U,2),VTYP="H" Q ; quit if admission
  1. K ^TMP("PXKENC",$J)
  1. D ENCEVENT^PXAPI(VISIT)
  1. D BLDPRMPT^ORFEDT(.ORPRMPTS)
  1. D BLDPARR^ORFEDT(.ORPARR)
  1. I '$D(^TMP("PXKENC",$J,VISIT,"VST",VISIT,0)) G GETFIND
  1. S $P(LST(1),U,6)=$D(^TMP("PXKENC",$J,VISIT,"CPT"))\10
  1. S X0=^TMP("PXKENC",$J,VISIT,"VST",VISIT,0),LOC=+$P(X0,U,22)
  1. S ILST=ILST+1,LST(ILST)="VST^DT^"_$P(X0,U)
  1. S ILST=ILST+1,LST(ILST)="VST^PT^"_$P(X0,U,5)
  1. S ILST=ILST+1,LST(ILST)="VST^HL^"_LOC_"^^"_$P($G(^SC(LOC,0)),U)
  1. S ILST=ILST+1,LST(ILST)="VST^PS^0" ;outpt
  1. ;S X0=$G(^TMP("PXKENC",$J,VISIT,"VST",VISIT,800))
  1. N VAL,SCNODE
  1. S SCNODE=$G(^TMP("PXKENC",$J,VISIT,"VST",VISIT,800))
  1. ;D SCSEL^ORWPCE(.VAL,$P(X0,U,5),$P(X0,U),LOC,VISIT)
  1. ;S ILST=ILST+1,LST(ILST)="VST^SC^"_$P($P(VAL,";",1),U,2)
  1. S ILST=ILST+1,LST(ILST)="VST^SC^"_$P(SCNODE,U)
  1. ;S ILST=ILST+1,LST(ILST)="VST^AO^"_$P($P(VAL,";",2),U,2)
  1. S ILST=ILST+1,LST(ILST)="VST^AO^"_$P(SCNODE,U,2)
  1. ;S ILST=ILST+1,LST(ILST)="VST^IR^"_$P($P(VAL,";",3),U,2)
  1. S ILST=ILST+1,LST(ILST)="VST^IR^"_$P(SCNODE,U,3)
  1. ;S ILST=ILST+1,LST(ILST)="VST^EC^"_$P($P(VAL,";",4),U,2)
  1. S ILST=ILST+1,LST(ILST)="VST^EC^"_$P(SCNODE,U,4)
  1. ;S ILST=ILST+1,LST(ILST)="VST^MST^"_$P($P(VAL,";",5),U,2)
  1. S ILST=ILST+1,LST(ILST)="VST^MST^"_$P(SCNODE,U,5)
  1. ;I $P(VAL,";",6)'="" D
  1. ;.S ILST=ILST+1,LST(ILST)="VST^HNC^"_$P($P(VAL,";",6),U,2)
  1. S ILST=ILST+1,LST(ILST)="VST^HNC^"_$P(SCNODE,U,6)
  1. ;I $P(VAL,";",7)'="" D
  1. ;.S ILST=ILST+1,LST(ILST)="VST^CV^"_$P($P(VAL,";",7),U,2)
  1. S ILST=ILST+1,LST(ILST)="VST^CV^"_$P(SCNODE,U,7)
  1. ;I $P(VAL,";",8)'="" D
  1. ;.S ILST=ILST+1,LST(ILST)="VST^SHAD^"_$P($P(VAL,";",8),U,2)
  1. S ILST=ILST+1,LST(ILST)="VST^SHAD^"_$P(SCNODE,U,8)
  1. ;for provider
  1. ; LST(n)="PRV"^ien^^^name^primary/secondary flag
  1. S IPRV=0 F S IPRV=$O(^TMP("PXKENC",$J,VISIT,"PRV",IPRV)) Q:'IPRV D
  1. . S X0=^TMP("PXKENC",$J,VISIT,"PRV",IPRV,0)
  1. . ;Q:$P(X0,U,4)'="P"
  1. . S CODE=$P(X0,U),NARR=$P($G(^VA(200,CODE,0)),U)
  1. . S PRIM=($P(X0,U,4)="P")
  1. . S ILST=ILST+1
  1. . S LST(ILST)="PRV"_U_CODE_"^^^"_NARR_"^"_PRIM
  1. S IPOV=0 F S IPOV=$O(^TMP("PXKENC",$J,VISIT,"POV",IPOV)) Q:'IPOV D
  1. . N ICDCSYS
  1. . S X0=^TMP("PXKENC",$J,VISIT,"POV",IPOV,0),X802=$G(^(802)),X811=$G(^(811))
  1. . S CODE=$P(X0,U),NARR=$P(X0,U,4),ICDCSYS=$$SAB^ICDEX($$CSI^ICDEX(80,CODE),DT)
  1. . I CODE D
  1. . . S CODE=$P($$ICDDATA^ICDXCODE(ICDCSYS,CODE,DT),U,2)
  1. . . S NARR=$$SETNARR(NARR,CODE)
  1. . S CAT=$P(X802,U)
  1. . S:CAT CAT=$P(^AUTNPOV(CAT,0),U)
  1. . S PRIM=($P(X0,U,12)="P")
  1. . S PRV=$P(X12,U,4)
  1. . S ILST=ILST+1
  1. . S LST(ILST)="POV"_U_CODE_U_CAT_U_NARR_U_PRIM_U_PRV
  1. . I X811]"" D
  1. .. S ICOM=ICOM+1
  1. .. S $P(LST(ILST),U,10)=ICOM
  1. .. S ILST=ILST+1
  1. .. S LST(ILST)="COM"_U_ICOM_U_X811
  1. S ICPT=0 F S ICPT=$O(^TMP("PXKENC",$J,VISIT,"CPT",ICPT)) Q:'ICPT D
  1. . S X0=^TMP("PXKENC",$J,VISIT,"CPT",ICPT,0),X802=$G(^(802)),X12=$G(^(12)),X811=$G(^(811))
  1. . S CODE=$$CODEC^ICPTCOD($P(X0,U)) ;ICR #1995
  1. . S:CODE=-1 CODE=""
  1. . S CAT=$P(X802,U)
  1. . S:CAT CAT=$P(^AUTNPOV(CAT,0),U)
  1. . S NARR=$P(X0,U,4)
  1. . S:NARR NARR=$P(^AUTNPOV(NARR,0),U)
  1. . S QTY=$P(X0,U,16)
  1. . S PRV=$P(X12,U,4)
  1. . S MCNT=0,MIDX=0,MODS=""
  1. . F S MIDX=$O(^TMP("PXKENC",$J,VISIT,"CPT",ICPT,1,MIDX)) Q:'MIDX D
  1. . . S MIEN=$G(^TMP("PXKENC",$J,VISIT,"CPT",ICPT,1,MIDX,0))
  1. . . I +MIEN S MCNT=MCNT+1,MODS=MODS_";/"_MIEN
  1. . I +MCNT S MODS=MCNT_MODS
  1. . S ILST=ILST+1
  1. . S LST(ILST)="CPT"_U_CODE_U_CAT_U_NARR_U_QTY_U_PRV_U_U_U_MODS
  1. . I X811]"" D
  1. .. S ICOM=ICOM+1
  1. .. S $P(LST(ILST),U,10)=ICOM
  1. .. S ILST=ILST+1
  1. .. S LST(ILST)="COM"_U_ICOM_U_X811
  1. ICR ;for contraindicated/refused:
  1. S ITEM=0 F S ITEM=$O(^TMP("PXKENC",$J,VISIT,"ICR",ITEM)) Q:ITEM'>0 D
  1. .K ORDATA D VICR^PXPXRM(ITEM,.ORDATA)
  1. .S ILST=ILST+1,TOPLST=ILST
  1. .S SUB="" F S SUB=$O(ORDATA(SUB)) Q:SUB="" D
  1. ..I ORDATA(SUB)="" Q
  1. ..I ORDATA(SUB)=U Q
  1. ..I SUB="REFUSED VACCINE GROUP" D Q
  1. ...S TEMP=ORDATA(SUB)
  1. ...S $P(LST(TOPLST),U,ORPRMPTS("pnumRefusedGroup"))='TEMP
  1. ..S ORPVAL=$G(ORPARR(SUB)) I ORPVAL="" Q
  1. ..I ORPVAL>0 D Q
  1. ...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
  1. ...S $P(LST(TOPLST),U,ORPVAL)=$G(ORDATA(SUB))
  1. ..I ORPVAL="CONTRA" D Q
  1. ...S TEMP=ORDATA(SUB)
  1. ...I TEMP[920.4 S $P(LST(TOPLST),U,ORPRMPTS("pnumImmContra"))=$TR(TEMP,U,":") Q
  1. ...S $P(LST(TOPLST),U,ORPRMPTS("pnumImmRefused"))=$TR(TEMP,U,":")
  1. ..I ORPVAL="COMMENT",$G(ORDATA(SUB))'="" D Q
  1. ...S ICOM=ICOM+1
  1. ...S $P(LST(TOPLST),U,10)=ICOM
  1. ...S ILST=ILST+1,LST(ILST)="COM"_U_ICOM_U_ORDATA(SUB)
  1. ..S $P(LST(TOPLST),U,ORPRMPTS(ORPVAL))=$TR(ORDATA(SUB),U,";")
  1. IMM ;for immunization:
  1. ; LST(n)="IMM"^Code^^^Series^prv^Reaction^Contraindicated^Refused
  1. S IIMM=0 F S IIMM=$O(^TMP("PXKENC",$J,VISIT,"IMM",IIMM)) Q:'IIMM D
  1. .K ORDATA D VIMM^PXPXRM(IIMM,.ORDATA)
  1. .S ILST=ILST+1,TOPLST=ILST
  1. .S LST(TOPLST)="IMM"_U
  1. .S SUB="" F S SUB=$O(ORDATA(SUB)) Q:SUB="" D
  1. ..I SUB="VISIT DATE TIME" Q
  1. ..S ORPVAL=$G(ORPARR(SUB)) I ORPVAL="" Q
  1. ..I +ORPVAL>0 D Q
  1. ...I ORPVAL=4 S $P(LST(TOPLST),U,4)=$P($G(ORDATA(SUB)),U,2),$P(LST(TOPLST),U,2)=+ORDATA(SUB) Q
  1. ...S $P(LST(TOPLST),U,ORPVAL)=$G(ORDATA(SUB))
  1. ..I ORPVAL="pnumComment" D Q
  1. ...I $G(ORDATA(SUB))'="" D
  1. ....S ICOM=ICOM+1
  1. ....S $P(LST(TOPLST),U,10)=ICOM
  1. ....S ILST=ILST+1,LST(ILST)="COM"_U_ICOM_U_ORDATA(SUB)
  1. ..I ORPVAL="pnumImmOverride",$G(ORDATA(SUB))'="" D Q
  1. ...S ICOM=ICOM+1
  1. ...S $P(LST(TOPLST),U,24)=ICOM
  1. ...S ILST=ILST+1,LST(ILST)="COM"_U_ICOM_U_ORDATA(SUB)
  1. ..I ORPVAL="pnumIMMVIS" D Q
  1. ...S VIS=""
  1. ...S VISCNT=0 F S VISCNT=$O(ORDATA(SUB,VISCNT)) Q:VISCNT'>0 D
  1. ....S VISTEMP=$TR($P(ORDATA(SUB,VISCNT,0),U,1,2),U,"/")
  1. ....I VIS'="" S VIS=VISTEMP_";"_VISTEMP Q
  1. ....S VIS=VISTEMP
  1. ...I VIS'="" S $P(LST(TOPLST),U,21)=VIS
  1. ..I $G(ORPRMPTS(ORPVAL))="" Q
  1. ..I ORPVAL="pnumImmSite" D Q
  1. ...S $P(LST(TOPLST),U,ORPRMPTS(ORPVAL))=$P(ORDATA(SUB),U,3)_";"_$P(ORDATA(SUB),U,2)_";"_$P(ORDATA(SUB),U)
  1. ..I SUB'="CODES" S $P(LST(TOPLST),U,ORPRMPTS(ORPVAL))=$TR(ORDATA(SUB),U,";")
  1. SKT ;for skin test:
  1. ; LST(n)="SK"^Code^^^result^prv^reading^d/t read^d/t given
  1. S ISK=0 F S ISK=$O(^TMP("PXKENC",$J,VISIT,"SK",ISK)) Q:'ISK D
  1. .K ORDATA D VSKIN^PXPXRM(ISK,.ORDATA)
  1. .S ILST=ILST+1,TOPLST=ILST
  1. .S LST(TOPLST)="SK"_U
  1. .S SUB="" F S SUB=$O(ORDATA(SUB)) Q:SUB="" D
  1. ..I SUB="VISIT DATE TIME" Q
  1. ..S ORPVAL=$G(ORPARR(SUB)) I ORPVAL="" Q
  1. ..I +ORPVAL>0 D Q
  1. ...I ORPVAL=4 S $P(LST(TOPLST),U,4)=$P($G(ORDATA(SUB)),U,2),$P(LST(TOPLST),U,2)=+ORDATA(SUB) Q
  1. ...S $P(LST(TOPLST),U,ORPVAL)=$TR(ORDATA(SUB),U,";")
  1. ..I ORPVAL="pnumComment" D Q
  1. ...I $G(ORDATA(SUB))="" Q
  1. ...S ICOM=ICOM+1
  1. ...S CPIECE=10
  1. ...I SUB="READING COMMENTS" S CPIECE=14
  1. ...S $P(LST(TOPLST),U,CPIECE)=ICOM
  1. ...S ILST=ILST+1,LST(ILST)="COM"_U_ICOM_U_ORDATA(SUB)
  1. ..I $G(ORPRMPTS(ORPVAL))="" Q
  1. ..I ORPVAL="SK_RES" D Q
  1. ...S $P(LST(TOPLST),U,ORPRMPTS(ORPVAL))=$S($G(ORDATA(SUB))="D":"Doubtful",$G(ORDATA(SUB))="N":"Negative",$G(ORDATA("SUB"))="P":"Postive",1:"")
  1. ..I ORPVAL="pnumImmSite" D Q
  1. ...S $P(LST(TOPLST),U,ORPRMPTS(ORPVAL))=$P(ORDATA(SUB),U,3)_";"_$P(ORDATA(SUB),U,2)_";"_$P(ORDATA(SUB),U)
  1. ..S $P(LST(TOPLST),U,ORPRMPTS(ORPVAL))=$TR(ORDATA(SUB),U,";")
  1. ;for patient education:
  1. ; LST(n)="PED"^Code^^^level of understanding^prv
  1. S IPED=0 F S IPED=$O(^TMP("PXKENC",$J,VISIT,"PED",IPED)) Q:'IPED D
  1. . S X0=^TMP("PXKENC",$J,VISIT,"PED",IPED,0),X12=$G(^(12)),X220=$G(^(220)),X811=$G(^(811))
  1. . S CODE=$P(X0,U)
  1. . S:CODE NARR=$P(^AUTTEDT(CODE,0),U)
  1. . S MAG=$P(X220,U,1)
  1. . S UCUM=$P(X220,U,2)
  1. . S QTY=$P(X0,U,6)
  1. . S CAT=""
  1. . S PRV=$P(X12,U,4)
  1. . S ILST=ILST+1
  1. . S LST(ILST)="PED"_U_CODE_U_CAT_U_NARR_U_QTY_U_PRV_U_MAG_U_UCUM
  1. . I X811]"" D
  1. .. S ICOM=ICOM+1
  1. .. S $P(LST(ILST),U,10)=ICOM
  1. .. S ILST=ILST+1
  1. .. S LST(ILST)="COM"_U_ICOM_U_X811
  1. ;for health factors:
  1. ; LST(n)="HF"^Code^^^level/severity^prv
  1. S IHF=0 F S IHF=$O(^TMP("PXKENC",$J,VISIT,"HF",IHF)) Q:'IHF D
  1. . S X0=^TMP("PXKENC",$J,VISIT,"HF",IHF,0),X12=$G(^(12)),X220=$G(^(220)),X811=$G(^(811))
  1. . S CODE=$P(X0,U)
  1. . S:CODE NARR=$P(^AUTTHF(CODE,0),U)
  1. . S MAG=$P(X220,U,1)
  1. . S UCUM=$P(X220,U,2)
  1. . S QTY=$P(X0,U,4)
  1. . S CAT=""
  1. . S PRV=$P(X12,U,4)
  1. . S ILST=ILST+1
  1. . S LST(ILST)="HF"_U_CODE_U_CAT_U_NARR_U_QTY_U_PRV_U_MAG_U_UCUM
  1. . I X811]"" D
  1. .. S ICOM=ICOM+1
  1. .. S $P(LST(ILST),U,10)=ICOM
  1. .. S ILST=ILST+1
  1. .. S LST(ILST)="COM"_U_ICOM_U_X811
  1. ;for exam:
  1. ; LST(n)="XAM"^Code^^^result^prv
  1. S IXAM=0 F S IXAM=$O(^TMP("PXKENC",$J,VISIT,"XAM",IXAM)) Q:'IXAM D
  1. . S X0=^TMP("PXKENC",$J,VISIT,"XAM",IXAM,0),X12=$G(^(12)),X220=$G(^(220)),X811=$G(^(811))
  1. . S CODE=$P(X0,U)
  1. . S:CODE NARR=$P(^AUTTEXAM(CODE,0),U)
  1. . S MAG=$P(X220,U,1)
  1. . S UCUM=$P(X220,U,2)
  1. . S QTY=$P(X0,U,4)
  1. . S CAT=""
  1. . S PRV=$P(X12,U,4)
  1. . S ILST=ILST+1
  1. . S LST(ILST)="XAM"_U_CODE_U_CAT_U_NARR_U_QTY_U_PRV_U_MAG_U_UCUM ;$P(X0,U,6,7)
  1. . I X811]"" D
  1. .. S ICOM=ICOM+1
  1. .. S $P(LST(ILST),U,10)=ICOM
  1. .. S ILST=ILST+1
  1. .. S LST(ILST)="COM"_U_ICOM_U_X811
  1. ;for Standard Codes:
  1. ; LST(n)="SC"^Code^^Narritive^Coding System^prv^Mag^UCUM
  1. S IST=0 F S IST=$O(^TMP("PXKENC",$J,VISIT,"SC",IST)) Q:'IST D
  1. . S X0=^TMP("PXKENC",$J,VISIT,"SC",IST,0),X12=$G(^(12)),X220=$G(^(220)),X811=$G(^(811))
  1. . S CODE=$P(X0,U)
  1. . S SYSIEN=$P($$CSYS^LEXU($P(X0,U,5)),U,1)
  1. . I CODE S NARR=$P($$EXP^LEXCODE(CODE,SYSIEN,$P(VSTR,";",2)),U,2) ;S NARR=$P($G(^AUPNVSC(CODE,0)),U)
  1. . S MAG=$P(X220,U,1)
  1. . S UCUM=$P(X220,U,2)
  1. . S CAT=$P(X0,U,5)
  1. . S PRV=$P(X12,U,4)
  1. . S ILST=ILST+1
  1. . S LST(ILST)="SC"_U_CODE_U_U_NARR_U_CAT_U_PRV_U_MAG_U_UCUM
  1. . I X811]"" D
  1. .. S ICOM=ICOM+1
  1. .. S $P(LST(ILST),U,10)=ICOM
  1. .. S ILST=ILST+1
  1. .. S LST(ILST)="COM"_U_ICOM_U_X811
  1. ;for treatment:
  1. ; LST(n)="TRT"^Code^CAT^NARR^QTY^prv
  1. S ITRT=0 F S ITRT=$O(^TMP("PXKENC",$J,VISIT,"TRT",ITRT)) Q:'ITRT D
  1. . S X0=^TMP("PXKENC",$J,VISIT,"TRT",ITRT,0),X802=$G(^(802)),X12=$G(^(12)),X811=$G(^(811))
  1. . S CODE=$P(X0,U)
  1. . S QTY=$P(X0,U,4)
  1. . S CAT=$P(X802,U)
  1. . S NARR=$P(X0,U,6)
  1. . S:CAT CAT=$P(^AUTNPOV(CAT,0),U)
  1. . S:NARR NARR=$P(^AUTNPOV(NARR,0),U)
  1. . S PRV=$P(X12,U,4)
  1. . S ILST=ILST+1
  1. . S LST(ILST)="TRT"_U_CODE_U_CAT_U_NARR_U_QTY_U_PRV
  1. . I X811]"" D
  1. .. S ICOM=ICOM+1
  1. .. S $P(LST(ILST),U,10)=ICOM
  1. .. S ILST=ILST+1
  1. .. S LST(ILST)="COM"_U_ICOM_U_X811
  1. GETFIND ;
  1. D GETFIND^PXRMRPCG(.GFINDS,DFN,VISIT,$G(IEN))
  1. S GCNT=0 F S GCNT=$O(GFINDS(GCNT)) Q:GCNT'>0 D
  1. .S ILST=ILST+1
  1. .S LST(ILST)=GFINDS(GCNT)
  1. Q
  1. GETDXTXT(ORY,NARR,CODE) ; RPC to resolve Dx Text for PCE view
  1. S ORY=$$SETNARR(NARR,CODE)
  1. Q
  1. SETNARR(NARR,CODE) ; Set narrative string
  1. N I,PRIMCODE,ICDLBL
  1. I (NARR?1.N),($P($G(^AUTNPOV(+NARR,0)),U)]"") S NARR=$P($G(^AUTNPOV(+NARR,0)),U)
  1. ;S:(ICDD]"")&($$UP^XLFSTR(NARR)'[$$UP^XLFSTR(ICDD)) NARR=$P(NARR," (")_" - "_ICDD_" - "_$S(NARR[" (":" (",1:"")_$P(NARR," (",2)
  1. ;S:NARR'[CODE NARR=$S(NARR["(SCT":$P(NARR,")")_", ",1:NARR_" (")_"ICD-9-CM "_CODE_")"
  1. I NARR["(SNOMED CT" S NARR=$P(NARR,"(")_"(SCT"_$P($P(NARR,")"),"(SNOMED CT",2)_")"
  1. E I NARR["SNOMED CT" S NARR=$P(NARR,"SNOMED CT")_"(SCT"_$P($P(NARR,":"),"SNOMED CT",2)_")"
  1. S PRIMCODE=$S(CODE["/":$P(CODE,"/"),1:CODE),ICDLBL=$P($$CODECS^ICDEX(PRIMCODE,80,DT),U,2)
  1. I CODE["/" F I=1:1:$L(CODE,"/") D
  1. . N ICDC,ICDD S ICDC=$P(CODE,"/",I),ICDD=$$ICDDESC(ICDC)
  1. . I (NARR'[ICDC)&((ICDD]"")&($$UP^XLFSTR(NARR)'=$$UP^XLFSTR(ICDD))) S NARR=NARR_" - "_ICDD_" ("_$G(ICDLBL)_" "_ICDC_")"
  1. . E S:NARR'[ICDC NARR=NARR_" ("_$G(ICDLBL)_" "_ICDC_")"
  1. E D
  1. . N ICDD S ICDD=$$ICDDESC(CODE)
  1. . I (NARR'[CODE)&((ICDD]"")&($$UP^XLFSTR(NARR)'=$$UP^XLFSTR(ICDD))) S NARR=NARR_" - "_ICDD_" ("_$G(ICDLBL)_" "_CODE_")"
  1. . E S:NARR'[CODE NARR=NARR_" ("_$G(ICDLBL)_" "_CODE_")"
  1. Q NARR
  1. ICDDESC(ORCODE,ORDT) ; Get description for ICD9 Code
  1. N ICDD,ORY S ORY="",ORDT=$G(ORDT,DT)
  1. D ICDDESC^ICDXCODE("DIAGNOSIS",ORCODE,ORDT,.ICDD)
  1. I '$D(ICDD) G ICDDESQ
  1. S ORY=$$SENTENCE^XLFSTR($G(ICDD(1)))
  1. ICDDESQ Q ORY