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