- APSPPCC2 ;IHS/CIA/PLS - PCC Hook for Pharmacy Package - Continued ;12-Feb-2008 16:01;SM
- ;;7.0;IHS PHARMACY MODIFICATIONS;**1006**;Sep 23, 2004
- ; Outside Medication VMED support
- EN(IEN,MSG) ;EP
- ; Mapping Table
- ; NVA VMED
- ; Dispense Drug Drug (.01)
- ; File 55 .01 .02
- ; Medication Route SIG
- ; Documented Date Visit Date
- ; Clinic Visit Clinic
- ; Disclaimer Comment
- ; Discontinued Date Date Discontinued
- ; IEN EHR Outside Med
- ;
- N DEFOLOC,IN,OUT,DFN,SEG,LP,DL1,DL2,ERR,PCC,SIG,ORDNUM
- N VSTR,NVA0,COM,STATUS,VMED,VSIT,VM0,DAT,DRG,CAN,COM1
- S LP=0
- S SEG=$$SEG^APSPPCC("MSH",.LP)
- Q:'LP
- S DL1=$E(SEG,4),DL2=$E(SEG,5)
- S SEG=$$SEG^APSPPCC("PID",.LP)
- S DFN=$P(SEG,DL1,4)
- Q:'DFN
- S DEFOLOC=$$GET^XPAR("ALL","BEHOENCX OTHER LOCATION")
- S:'DEFOLOC DEFOLOC=DUZ(2)
- ;D LOG
- ;
- S NVA0=$G(^PS(55,DFN,"NVA",+IEN,0))
- S DRG=$P(NVA0,U,2)
- S CAN=$P(NVA0,U,7)
- S ORDNUM=$P(NVA0,U,8)
- S SIG=$$SIG(ORDNUM)
- S VMED=$G(^PS(55,DFN,"NVA",+IEN,999999911))
- S VM0=$S(VMED:$G(^AUPNVMED(VMED,0)),1:"")
- S DAT=+$S($P(NVA0,U,9):$P(NVA0,U,9),1:$P(NVA0,U,10))
- S VSIT=$P(VM0,U,3)
- S VSTR="0;"_DAT_";E;"_$S('VSIT:";"_-DEFOLOC,1:VSIT)
- S STATUS=$P(NVA0,U,6)
- S ACT=$S(STATUS:"",VMED:"",1:"+")
- S COM=$O(^PS(55,DFN,"NVA",1,"DSC",0))
- S:COM COM1=$O(^PS(55,DFN,"NVA",1,"DSC",COM))
- S:COM COM=$G(^PS(55,DFN,"NVA",1,"DSC",COM,0))
- D ADD("HDR^^^"_VSTR)
- D ADD("VST^PT^"_DFN)
- D ADD("VST^DT^"_DAT)
- ;I VM0,DRG'=+VM0 D ADD("RX-^"_+VM0_U_VMED_U_IEN) S ACT="+"
- D ADD("RXV"_ACT_U_DRG_U_VMED_U_IEN_U_DFN_U_U_U_U_CAN_U)
- D:$L(COM) ADD("COM^1^"_$S($L(COM)<71:COM,1:$E(COM,1,69)_"~"))
- D ADD("SIG^1^"_$S($L(SIG)<146:SIG,1:$E(SIG,1,144)_"~"))
- D SAVE^APSPPCCV(.ERR,.PCC)
- Q
- ADD(X) S PCC=$G(PCC)+1,PCC(PCC)=X
- Q
- ; Return SIG from Order
- SIG(ORIFN) ;EP
- N ID,LP,SIG
- Q:'$G(ORIFN) ""
- S ID=$$PTR(ORIFN,"SIG")
- Q:'ID ""
- S SIG=""
- S LP=0 F S LP=$O(^OR(100,ORIFN,4.5,ID,2,LP)) Q:'LP D
- .S SIG=SIG_$S($L(SIG):" ",1:"")_^OR(100,ORIFN,4.5,ID,2,LP,0)
- Q SIG
- PTR(ORIFN,ID) S ID=$O(^OR(100,ORIFN,4.5,"ID",ID,0))
- Q ID
- APSPPCC2 ;IHS/CIA/PLS - PCC Hook for Pharmacy Package - Continued ;12-Feb-2008 16:01;SM
- +1 ;;7.0;IHS PHARMACY MODIFICATIONS;**1006**;Sep 23, 2004
- +2 ; Outside Medication VMED support
- EN(IEN,MSG) ;EP
- +1 ; Mapping Table
- +2 ; NVA VMED
- +3 ; Dispense Drug Drug (.01)
- +4 ; File 55 .01 .02
- +5 ; Medication Route SIG
- +6 ; Documented Date Visit Date
- +7 ; Clinic Visit Clinic
- +8 ; Disclaimer Comment
- +9 ; Discontinued Date Date Discontinued
- +10 ; IEN EHR Outside Med
- +11 ;
- +12 NEW DEFOLOC,IN,OUT,DFN,SEG,LP,DL1,DL2,ERR,PCC,SIG,ORDNUM
- +13 NEW VSTR,NVA0,COM,STATUS,VMED,VSIT,VM0,DAT,DRG,CAN,COM1
- +14 SET LP=0
- +15 SET SEG=$$SEG^APSPPCC("MSH",.LP)
- +16 IF 'LP
- QUIT
- +17 SET DL1=$EXTRACT(SEG,4)
- SET DL2=$EXTRACT(SEG,5)
- +18 SET SEG=$$SEG^APSPPCC("PID",.LP)
- +19 SET DFN=$PIECE(SEG,DL1,4)
- +20 IF 'DFN
- QUIT
- +21 SET DEFOLOC=$$GET^XPAR("ALL","BEHOENCX OTHER LOCATION")
- +22 IF 'DEFOLOC
- SET DEFOLOC=DUZ(2)
- +23 ;D LOG
- +24 ;
- +25 SET NVA0=$GET(^PS(55,DFN,"NVA",+IEN,0))
- +26 SET DRG=$PIECE(NVA0,U,2)
- +27 SET CAN=$PIECE(NVA0,U,7)
- +28 SET ORDNUM=$PIECE(NVA0,U,8)
- +29 SET SIG=$$SIG(ORDNUM)
- +30 SET VMED=$GET(^PS(55,DFN,"NVA",+IEN,999999911))
- +31 SET VM0=$SELECT(VMED:$GET(^AUPNVMED(VMED,0)),1:"")
- +32 SET DAT=+$SELECT($PIECE(NVA0,U,9):$PIECE(NVA0,U,9),1:$PIECE(NVA0,U,10))
- +33 SET VSIT=$PIECE(VM0,U,3)
- +34 SET VSTR="0;"_DAT_";E;"_$SELECT('VSIT:";"_-DEFOLOC,1:VSIT)
- +35 SET STATUS=$PIECE(NVA0,U,6)
- +36 SET ACT=$SELECT(STATUS:"",VMED:"",1:"+")
- +37 SET COM=$ORDER(^PS(55,DFN,"NVA",1,"DSC",0))
- +38 IF COM
- SET COM1=$ORDER(^PS(55,DFN,"NVA",1,"DSC",COM))
- +39 IF COM
- SET COM=$GET(^PS(55,DFN,"NVA",1,"DSC",COM,0))
- +40 DO ADD("HDR^^^"_VSTR)
- +41 DO ADD("VST^PT^"_DFN)
- +42 DO ADD("VST^DT^"_DAT)
- +43 ;I VM0,DRG'=+VM0 D ADD("RX-^"_+VM0_U_VMED_U_IEN) S ACT="+"
- +44 DO ADD("RXV"_ACT_U_DRG_U_VMED_U_IEN_U_DFN_U_U_U_U_CAN_U)
- +45 IF $LENGTH(COM)
- DO ADD("COM^1^"_$SELECT($LENGTH(COM)<71:COM,1:$EXTRACT(COM,1,69)_"~"))
- +46 DO ADD("SIG^1^"_$SELECT($LENGTH(SIG)<146:SIG,1:$EXTRACT(SIG,1,144)_"~"))
- +47 DO SAVE^APSPPCCV(.ERR,.PCC)
- +48 QUIT
- ADD(X) SET PCC=$GET(PCC)+1
- SET PCC(PCC)=X
- +1 QUIT
- +2 ; Return SIG from Order
- SIG(ORIFN) ;EP
- +1 NEW ID,LP,SIG
- +2 IF '$GET(ORIFN)
- QUIT ""
- +3 SET ID=$$PTR(ORIFN,"SIG")
- +4 IF 'ID
- QUIT ""
- +5 SET SIG=""
- +6 SET LP=0
- FOR
- SET LP=$ORDER(^OR(100,ORIFN,4.5,ID,2,LP))
- IF 'LP
- QUIT
- Begin DoDot:1
- +7 SET SIG=SIG_$SELECT($LENGTH(SIG):" ",1:"")_^OR(100,ORIFN,4.5,ID,2,LP,0)
- End DoDot:1
- +8 QUIT SIG
- PTR(ORIFN,ID) SET ID=$ORDER(^OR(100,ORIFN,4.5,"ID",ID,0))
- +1 QUIT ID
