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 - Get a PCE encounter for a TIU document;11/21/03
  1.  ;;3.0;ORDER ENTRY/RESULTS REPORTING;**10,85,116,190**;Dec 17, 1997
  1.  Q
  1. PCE4NOTE(LST,IEN,DFN,VSITSTR) ; Return encounter for an associated note
  1.  ; LST(1)=HDR^AllowEdit^CPTRequired^VStr^Author^hasCPT
  1.  ; LST(n)=TYP+^CODE^CAT^NARR^QUAL1^QUAL2 (QUAL1=Primary!Qty, QUAL2=Prv)
  1.  N VISIT,VSTR,ILST,LOC,CODE,PRIM,QTY,CAT,NARR,PRV,X0,X12,X802,X811,VTYP
  1.  N IPOV,ICPT,IPRV,IIMM,ISK,IPED,IHF,IXAM,ITRT,ICOM,MIDX,MIEN,MCNT,MODS
  1.  I +$G(IEN)<1 D  I 1 ; Get PCE Data on a new note not yet saved
  1.  . S (X0,X12)=""
  1.  . S VISIT=$$GETENC^PXAPI(DFN,$P(VSITSTR,";",2),$P(VSITSTR,";"))
  1.  . S VSTR=VSITSTR
  1.  E  D
  1.  . S X0=^TIU(8925,IEN,0),X12=$G(^(12))
  1.  . S VISIT=$P(X12,U,7)
  1.  . I 'VISIT S VISIT=$P(X0,U,3)
  1.  . D NOTEVSTR^ORWPCE(.VSTR,IEN)
  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
  1.  I VISIT'>0 D  Q
  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.  I '$D(^TMP("PXKENC",$J,VISIT,"VST",VISIT,0)) Q
  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
  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^AO^"_$P($P(VAL,";",2),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^EC^"_$P($P(VAL,";",4),U,2)
  1.  S ILST=ILST+1,LST(ILST)="VST^MST^"_$P($P(VAL,";",5),U,2)
  1.  I $P(VAL,";",6)'="" D
  1.  .S ILST=ILST+1,LST(ILST)="VST^HNC^"_$P($P(VAL,";",6),U,2)
  1.  I $P(VAL,";",7)'="" D
  1.  .S ILST=ILST+1,LST(ILST)="VST^CV^"_$P($P(VAL,";",7),U,2)
  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.  . S X0=^TMP("PXKENC",$J,VISIT,"POV",IPOV,0),X802=$G(^(802)),X811=$G(^(811))
  1.  . S CODE=$P(X0,U)
  1.  . S:CODE CODE=$P(^ICD9(CODE,0),U)
  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 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=$P(X0,U)
  1.  . S CODE=$O(^ICPT("B",$P(X0,U),0))
  1.  . S:CODE CODE=$P(^ICPT(CODE,0),U)
  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.  ;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.  . S X0=^TMP("PXKENC",$J,VISIT,"IMM",IIMM,0),X12=$G(^(12)),X811=$G(^(811))
  1.  . S CODE=$P(X0,U)
  1.  . S:CODE NARR=$P(^AUTTIMM(CODE,0),U)
  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)="IMM"_U_CODE_U_CAT_U_NARR_U_QTY_U_PRV_U_$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 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.  . S X0=^TMP("PXKENC",$J,VISIT,"SK",ISK,0),X12=$G(^(12)),X811=$G(^(811))
  1.  . S CODE=$P(X0,U)
  1.  . S:CODE NARR=$P(^AUTTSK(CODE,0),U)
  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)="SK"_U_CODE_U_CAT_U_NARR_U_QTY_U_PRV_U_$P(X0,U,5,6)_U_$P(X12,U)
  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 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)),X811=$G(^(811))
  1.  . S CODE=$P(X0,U)
  1.  . S:CODE NARR=$P(^AUTTEDT(CODE,0),U)
  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
  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)),X811=$G(^(811))
  1.  . S CODE=$P(X0,U)
  1.  . S:CODE NARR=$P(^AUTTHF(CODE,0),U)
  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
  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)),X811=$G(^(811))
  1.  . S CODE=$P(X0,U)
  1.  . S:CODE NARR=$P(^AUTTEXAM(CODE,0),U)
  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_$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 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.  Q