PSJPADSI ;BIR/JCH PADE INBOUND SYSTEM SET UP ;8/25/15
;;5.0;INPATIENT MEDICATIONS;**317,337,362,392**;16 DEC 97;Build 2
;
; Reference to EDIT^XPAREDIT is supported by DBIA 2336.
; Reference to WIN^DGPMDDCF is supported by DBIA 1246.
; Reference to INP^VADPT is supported by DBIA 10061.
; Reference to ^DDIOL is supported by DBIA 10142.
; Reference to ^PS(55 is supported by DBIA 2191.
; Reference to ^DIC(42 is supported by DBIA 10039.
; Reference to ^SC( is supported by DBIA 10040.
; Reference to NOW^XLFDT is supported by DBIA 10153.
;
Q
;
ENCAB ; Setup Cabinet device in file 58.63
N PSJPADQ
F Q:$G(PSJPADQ)!$G(DUOUT)!$G(DTOUT) D PADEV
Q
;
PADEV ;enter/edit PADE devices and VistA locations
N DR,DA,DIC,DIE,X,Y,PSJPSYS,PSJPDEV,PADAR,DEVDA W !
S PSJPSYS=""
W ! D GETFILD(PSJPSYS,.DEVDA)
I '$G(DEVDA) S PSJPADQ=1 Q
I $G(DEVDA) D
.I $G(DUOUT)!($G(DTOUT))!$G(PSJPADQ) K DUOUT,DTOUT Q
.S DIE="^PS(58.63,",DA=+DEVDA,DR="[PSJ PADE DISPENSING DEVICE]" W ! D ^DIE
.Q:'$G(DA)!$G(DUOUT)!$G(DTOUT) N PSJPDEV S PSJPDEV=DA
K DIE,DIC
Q
;
GETFILD(PSJPSYS,DEVIEN) ; Get Device if it exists, or File Device if not
N PSJDIV,D K DEVIEN,LAYGO S DEVIEN=""
N DR,DIR,ERR,DEV,RESULT,TOT,RANGE,DEVPRMPT,PAD,PSJPNAM
W ! S DIC="^PS(58.63,",DIC(0)="EALNMV",LAYGO="58.63",DR="1"
S DR=1,DLAYGO=LAYGO
D ^DIC K DIC I Y>0 S DEVIEN=+Y
I Y<0 D DELBADSY^PSJPDRU1 ; If user aborted new device entry, may have left "?BAD" entry in 58.601 file due to invalid uniqueness key
I $G(DEVIEN),$G(PSJPSYS) D
.N FDA S FDA(58.63,DA,1)=PSJPSYS
.S FDA(58.63,DA,12)=$$UPPER^PSJPDRUT($P($G(^PS(58.63,+DEVIEN,0)),"^"))
.D FILE^DIE("","FDA","RESULT")
Q
;
ENSYS ; Setup PADE Inbound System in file 58.601
N PSJPADQ
F Q:$G(PSJPADQ)!$G(DUOUT)!$G(DTOUT) D PADESYS
Q
;
PADESYS ;enter/edit PADE inventory system
N DR,DA,DIC,DIE,X,Y,PSJPSYS,PSJPDEV,PADAR,DEVDA,PSJPSNM,DLAYGO,PSJASKDN W !
S Y=$$ENSYS^PSJPDRUT
Q:$G(DUOUT)!$G(DTOUT)
I Y<1 S PSJPADQ=1 Q
S (DA,PSJPSYS)=+Y
S DIE="^PS(58.601,",DR="[PSJ PADE INVENTORY]" D ^DIE
S PSJPSNM=$P($G(^PS(58.601,+$G(PSJPSYS),0)),"^")
I PSJPSNM=""!($G(PSJASKDN)=3) S PSJPADQ=1 Q
F Q:$G(PSJPADQ)!$G(DUOUT)!$G(DTOUT) D GETDEV(PSJPSYS,.DEVDA) I $G(DEVDA) D
.I $G(DUOUT)!($G(DTOUT))!$G(PSJPADQ) K DUOUT,DTOUT Q
.N DIE,DA,DR,X,Y
.S DIE="^PS(58.63,",DA=+DEVDA,DR="[PSJ PADE DISPENSING DEVICE]" W ! D ^DIE
.W !! S DIR(0)="FO",DIR("A")="Press return to continue" D ^DIR Q
K DIE,DIC,DTOUT,DUOUT,PSJPADQ
Q
;
GETDEV(PSJPSYS,DEVIEN) ; Get device ien
N PSJDIV K DEVIEN S DEVIEN=""
N DIR,ERR,DEV,RESULT,TOT,RANGE,DEVPRMPT,PAD,PSJPNAM
W ! S DIC="^PS(58.63,",DIC(0)="EAMV"
D ^DIC K DIC I Y>0 S DEVIEN=+Y
I $G(DEVIEN),$G(PSJPSYS) D
.N FDA S FDA(58.63,DEVIEN_",",1)=PSJPSYS
.S FDA(58.63,DEVIEN_",",12)=$$UPPER^PSJPDRUT($P($G(^PS(58.63,+DEVIEN,0)),"^"))
.D FILE^DIE("","FDA","RESULT")
S:'$G(DEVIEN)>0 PSJPADQ=1
Q
;
WARDSCR(Y) ; Ward Location Y must be associated with division PSJDIV in PADE inbound system DA(3)
N D0,X
S D0=+Y D WIN^DGPMDDCF Q:$G(X) 1
I $P(^DIC(42,D0,0),U,11)=$G(^PS(58.601,DA(3),"DIV",DA(2),0)) Q 1
Q 0
;
WARDSCR2(Y,DDEV) ; Ward Location Y must be associated with division PSJDIV in PADE inbound system DA(3)
N D0,X,DIV
S D0=+Y
Q:'$G(DDEV) 0
S DIV=$P($G(^PS(58.63,+DDEV,2)),"^")
Q:'DIV 0
I $P(^DIC(42,D0,0),U,11)=DIV Q 1
Q 0
;
CLCHK(QZ) ; Clinic Location QZ must be associated with division PSJDIV in PADE inbound system DA(3)
N PSJDIV S PSJDIV=$G(^PS(58.601,DA(3),"DIV",DA(2),0))
I $P(^SC(QZ,0),U,3)'="C" Q 0
I $P(^SC(QZ,0),U,15)'=PSJDIV Q 0
Q 1
;
CLCHK2(QZ,DDEV) ; Clinic Location QZ must be associated with division PSJDIV in PADE inbound system DA(3)
N PSJDIV
Q:'$G(DDEV) 0
S PSJDIV=$P($G(^PS(58.63,+DDEV,2)),"^")
Q:'PSJDIV 0
I $P(^SC(QZ,0),U,3)'="C" Q 0
I $P(^SC(QZ,0),U,15)'=PSJDIV Q 0
Q 1
;
CGCHK(QZ) ; Clinic Group QZ must have at least one clinic associated with division PSJDIV in PADE inbound system DA(3)
N PSJDIV,CL,CLIEN,GOTONE S PSJDIV=$G(^PS(58.601,DA(3),"DIV",DA(2),0))
S GOTONE=0
S CL=0 F Q:$G(GOTONE) S CL=$O(^PS(57.8,+QZ,1,CL)) Q:'CL D
.S CLIEN=+$G(^PS(57.8,+QZ,1,CL,0))
.I $P(^SC(CLIEN,0),U,15)=PSJDIV S GOTONE=1
Q:GOTONE 1
Q 0
;
CGCHK2(QZ,DDEV) ; Clinic Group QZ must have at least one clinic associated with division PSJDIV in PADE inbound system DA(3)
N PSJDIV,CL,CLIEN,GOTONE
Q:'$G(DDEV) 0
S PSJDIV=$P($G(^PS(58.63,+DDEV,2)),"^")
Q:'PSJDIV 0
S GOTONE=0
S CL=0 F Q:$G(GOTONE) S CL=$O(^PS(57.8,+QZ,1,CL)) Q:'CL D
.S CLIEN=+$G(^PS(57.8,+QZ,1,CL,0))
.I $P(^SC(CLIEN,0),U,15)=PSJDIV S GOTONE=1
Q:GOTONE 1
Q 0
;
WGCHK(QZ) ; Ward Group QZ must have at least one ward associated with division PSJDIV in PADE inbound system DA(3)
N PSJDIV,WD,WDIEN,GOTONE S PSJDIV=$G(^PS(58.601,DA(3),"DIV",DA(2),0))
S GOTONE=0
S WD=0 F Q:$G(GOTONE) S WD=$O(^PS(57.5,+QZ,1,WD)) Q:'WD D
.S WDIEN=+$G(^PS(57.5,+QZ,1,WD,0))
.I $P(^DIC(42,WDIEN,0),U,11)=PSJDIV S GOTONE=1
Q:GOTONE 1
Q 0
;
WGCHK2(QZ,DDEV) ; Ward Group QZ must have at least one ward associated with division PSJDIV in PADE inbound system DA(3)
N PSJDIV,WD,WDIEN,GOTONE
Q:'$G(DDEV) 0
S PSJDIV=$P($G(^PS(58.63,+DDEV,2)),"^")
Q:'PSJDIV 0
S GOTONE=0
S WD=0 F Q:$G(GOTONE) S WD=$O(^PS(57.5,+QZ,1,WD)) Q:'WD D
.S WDIEN=+$G(^PS(57.5,+QZ,1,WD,0))
.I $P(^DIC(42,WDIEN,0),U,11)=PSJDIV S GOTONE=1
Q:GOTONE 1
Q 0
;
SYSHLP ; User help for PADE INVENTORY SYSTEM (#.01) field of PADE INVENTORY SYSTEM (#58.601) file
N ARRAY
S ARRAY(1)=" Enter the name of the Pharmacy Automated Dispensing Equipment (PADE)."
S ARRAY(2)=" system. This must be the same as the System Name in the HL7 messages"
S ARRAY(3)=" received from the PADE vendor interface."
S ARRAY(4)=""
D WRITE(.ARRAY)
Q
;
DDEVHLP ; User help for DISPENSING DEVICE (#1) field of PADE INVENTORY SYSTEM (#58.601) file
N ARRAY
S ARRAY(1)=" Enter the name of the specific dispensing device, also known as"
S ARRAY(2)=" a Station or Cabinet. This must match exactly the name of the"
S ARRAY(3)=" device on the PADE system."
S ARRAY(4)=""
D WRITE(.ARRAY)
Q
;
CBALHLP ; User help for CALCULATED DEVICE BALANCE (#1) field in DRUG (DEVICE) (#58.60111) sub-file.
N ARRAY
S ARRAY(1)=" CAUTION: The Calculated Device Balance is calculated using information"
S ARRAY(2)=" received from the dispensing system. Verify the balance on the dispensing"
S ARRAY(3)=" device before making edits to this field."
S ARRAY(4)=""
D WRITE(.ARRAY)
Q
RBALHLP ; User help for REPORTED DEVICE BALANCE (#2) field in DRUG (DEVICE) (#58.60111) sub-file.
N ARRAY
S ARRAY(1)=" CAUTION: The Reported Device Balance is received directly from the"
S ARRAY(2)=" dispensing system. Verify the balance on the dispensing device before"
S ARRAY(3)=" making edits to this field, or correct the balance on the PADE system."
S ARRAY(4)=""
D WRITE(.ARRAY)
Q
;
DRGINHLP ; User help for INACTIVE DATE/TIME (#3) field in the DRUG (DEVICE) (#58.60111) sub-file.
N ARRAY
S ARRAY(1)=" Enter the Date/Time a drug was completely removed from the device,"
S ARRAY(2)=" indicating the drug will no longer be available from that device."
S ARRAY(3)=""
D WRITE(.ARRAY)
Q
;
DIVHLP ; User help for DIVISION (#3) field, sub-file 58.6013.
N ARRAY
S ARRAY(1)=" Enter a Medical Center Division associated with this PADE inbound system."
S ARRAY(2)=" PADE dispensing devices may be associated with Divisions so that PADE"
S ARRAY(3)=" inventory may be updated accurately in VistA."
S ARRAY(4)=""
D WRITE(.ARRAY)
Q
;
WRITE(ARRAY) ; Write contents of ARRAY to screen
D EN^DDIOL(.ARRAY)
Q
;
DWOIN(DWOTIM) ; Input Transform-Dispensed without orders-length of time after dispense that order creation is allowed
N DWOVAL,UNIT,MULT,NUM
S NUM=+DWOTIM
S UNIT=$E($P(DWOTIM,NUM,2))
Q:'$G(DWOTIM) 0
S MULT=$S(UNIT="H":60,UNIT="D":1440,UNIT="M":1,UNIT="S":1/60,1:1)
S DWOVAL=DWOTIM*MULT
Q $$ROUND(DWOVAL)
;
ROUND(NUM) ; Round
Q:'NUM 0
N DIV,REM
S DIV=NUM\1,REM=NUM#1
S DIV=$S(REM<.5:DIV,1:DIV+1)
Q DIV
;
ASKDONE() ; Ask next action
N DIR,PSJSNAM,X,Y
S PSJSNAM=$P($G(^PS(58.601,+$G(PSJPSYS),0)),"^")
S DIR(0)="S^R:Re-edit "_PSJSNAM_" System;D:Edit "_$S(PSJSNAM]"":PSJSNAM_" ",1:"")_"PADE Devices;Q:Quit"
S DIR("A",1)="Finished editing PADE System "_PSJSNAM
S DIR("A")="(R)e-edit PADE system, edit (D)evice, or (Q)uit (R,D,Q)"
D ^DIR S PSJASKDN=$S(Y="R":1,Y="D":2,1:3)
Q PSJASKDN
;
DWODEV(CABNUM) ; Prompt for Dispensed Without Orders Mail Group for Device CABINET
N DIC,DA,DR,X,Y,DIE,DR,CABNAME,PSJPSYS,DWOIEN,DP,DL,DI
Q:'$G(CABNUM)
D GETS^DIQ(58.63,+CABNUM,".01;1","IE","CABNAME")
S CABNAME=$G(CABNAME(58.63,CABNUM_",",.01,"E"))
S PSJPSYS=$G(CABNAME(58.63,CABNUM_",",1,"I"))
Q:(CABNAME="")
S DWOIEN=$$FIND1^DIC(58.6014,","_+$G(PSJPSYS)_",","","PC."_CABNAME)
I 'DWOIEN D Q:'DWOIEN
.N DIC,DA,DR,X,Y,DIE,DR,DP,DL,DO,DI
.S DIC="^PS(58.601,"_PSJPSYS_",2,",DIC(0)="ZL",DIC("P")="58.6014V"
.S DA(1)=PSJPSYS,X=CABNUM_";PS(58.63,"
.D FILE^DICN I Y>0 S DWOIEN=+Y
Q:'DWOIEN
W ! D EN^DDIOL("DWO ENTITY: "_CABNAME)
S DIE="^PS(58.601,"_PSJPSYS_",2,",DA=+DWOIEN,DA(1)=+PSJPSYS,DR="1" D ^DIE
Q
;
DRGFLAG(DFN,PSGORD,PSJDFLOC,ON,PSJNEWOE) ; Get flag indicating order is PADE order
N PSJPSYS,PSJDRGCT,PSJLOC,PSJDSTK,PSJLOCTP,PSDRGTOT,PSDRUG,PSJRFND,X,Y,PSJNOTPD
I '$G(PSGORD),$G(PSJNEWOE),$G(ON)["P" N PSGORD S PSGORD=$G(ON) ; If new order, no order number passed in
; Patient DFN and order PSGORD are required, quit if not passed
Q:'$G(DFN)!'$G(PSGORD) ""
;
S PSJRFND=0
; Unit Dose Active, Pending, Non-Verified
I PSGORD["U"!(PSGORD["P") D Q PSJRFND
.I $S(PSGORD["U":'$D(^PS(55,+$G(DFN),5,+$G(PSGORD),1)),1:'$D(^PS(53.1,+PSGORD,1))) S PSJRFND="" Q
.N PSDDIEN
.D:PSGORD["U" GETUDRG(DFN,PSGORD,.PSJLOC,.PSJLOCTP,.PSDRUG)
.D:PSGORD["P" GETPDRG(DFN,PSGORD,.PSJLOC,.PSJLOCTP,.PSDRUG)
.S PSJRFND=$$PSJRFND(DFN,PSGORD,.PSJLOC,.PSJLOCTP,.PSDRUG)
;
; Complex orders
I PSGORD=+PSGORD D Q PSJRFND
.N PSJPRNT S PSJPRNT=+PSGORD
.S PSGORD=0 F S PSGORD=$O(^PS(53.1,"ACX",PSJPRNT,PSGORD)) Q:'PSGORD!$G(PSJRFND) D
..Q:'$D(^PS(53.1,+PSGORD,0)) N PSDDIEN
..D GETPDRG(DFN,PSGORD_"P",.PSJLOC,.PSJLOCTP,.PSDRUG)
..S PSJRFND=$$PSJRFND(DFN,PSGORD_"P",.PSJLOC,.PSJLOCTP,.PSDRUG)
;
Q PSJRFND
;
DRGSTOCK(DFN,PSGORD,PSJDFLOC,PS5345,DRGIEN) ; Get Quantity of Drug in PADE for patient DFN order PSGORD
; PSGORD = Clinic Order - find PADEs associated with the Clinic, return total quantity in all qualifying PADEs
; PSGORD = Regular UD order - find PADEs associated with patient's ward location, return total quantity in all PADEs
;
N PSJPSYS,PSJDRGCT,PSJLOC,PSJDSTK,PSJLOCTP,PSDRGTOT,PSDRUG,PSDRFND,X,Y,PSJNOTPD
S PSJDSTK="",PSDRGTOT=0
; Patient DFN and order PSGORD are required, quit if not passed
I '$G(DFN) Q ""
I '$G(PSGORD) D I '$G(DRGIEN)!'$G(PSJLOC) Q ""
.S PSGORD=""
.I '$G(PSJDFLOC) D
..I '$G(VAIN(4)) N VAIN D INP^VADPT
..S PSJDFLOC=+$G(VAIN(4))_"WD"
.S PSJLOCTP=$P(PSJDFLOC,+PSJDFLOC,2) Q:PSJLOCTP=""
.S PSJLOC=+$G(PSJDFLOC)
;
;Get location and default drug ien for Active UD and NON-VERIFIED/PENDING UD order.
; If a specific drug was passed in via DRGIEN or PS5345 skip this and find balance for that drug
I PSGORD["U"!(PSGORD["P") S PSDRFND="" D Q:PSDRFND]"" PSDRFND
.Q:$S(PSGORD["U":'$D(^PS(55,+$G(DFN),5,+$G(PSGORD),0)),1:'$D(^PS(53.1,+PSGORD,0)))
.N PSDDIEN
.D:PSGORD["U" GETUDRG(DFN,PSGORD,.PSJLOC,.PSJLOCTP,.PSDRUG)
.D:PSGORD["P" GETPDRG(DFN,PSGORD,.PSJLOC,.PSJLOCTP,.PSDRUG)
;
; If pointer to DISPENSE DRUG multiple (#2) in INPATIENT USER PARAMETERS (#53.45) file is passed, get default drug ien
I $G(PS5345) N TMP S TMP=+$G(^PS(53.45,+$G(PSJSYSP),2,+$G(PS5345),0)) I $G(TMP) S PSDRUG=TMP
; If a specific drug ien pointer to DRUG file (#50) is passed in, use that
I $G(DRGIEN) S PSDRUG=+DRGIEN
;
I '$G(PSDRUG) Q "NA"
;
S PSDRGTOT=$$DRGQTY(PSDRUG,PSJLOCTP,PSJLOC)
Q PSDRGTOT
;
GETUDRG(DFN,PSGORD,PSJLOC,PSJLOCTP,PSDRUG) ; Get UD order location and drug from UD multiple (#62) of PHARMACY PATIENT file (#55)
;
K PSJLOC,PSJLOCTP,PSDRUG N DDCNT,TMPDRG,TMPLOC
S DDCNT=0 F S DDCNT=$O(^PS(55,+$G(DFN),5,+PSGORD,1,DDCNT)) Q:'DDCNT D
.S TMPDRG=+$G(^PS(55,+DFN,5,+PSGORD,1,DDCNT,0))
.S:TMPDRG PSDRUG(TMPDRG)=""
.S:'$G(PSDRUG) PSDRUG=TMPDRG
S TMPLOC=$G(^PS(55,+DFN,5,+PSGORD,8)),PSJLOCTP="CL" S PSJLOC=$S(+TMPLOC&$P(TMPLOC,"^",2):+TMPLOC,1:"")
I 'PSJLOC N VAIN,VAINDT,VAHOW,VAROOT D INP^VADPT S PSJLOC=$G(VAIN(4)) S PSJLOCTP="WD"
Q
;
GETPDRG(DFN,PSGORD,PSJLOC,PSJLOCTP,PSDRUG) ; Get UD order location and drug from NON VERIFIED/PENDING file (#53.1)
;
K PSJLOC,PSJLOCTP,PSDRUG N DDCNT,TMPDRG,TMPLOC
S DDCNT=0 F S DDCNT=$O(^PS(53.1,+PSGORD,1,DDCNT)) Q:'DDCNT D
.S TMPDRG=+$G(^PS(53.1,+PSGORD,1,DDCNT,0))
.S:TMPDRG PSDRUG(TMPDRG)=""
.S:'$G(PSDRUG) PSDRUG=TMPDRG
S TMPLOC=$G(^PS(53.1,+PSGORD,"DSS")),PSJLOCTP="CL" S PSJLOC=$S(+TMPLOC&$P(TMPLOC,"^",2):+TMPLOC,1:"")
I 'PSJLOC N VAIN D INP^VADPT S PSJLOC=$G(VAIN(4)),PSJLOCTP="WD"
I $D(PSDRUG)<10 D
.N PSJOI S PSJOI=+$G(^PS(53.1,+PSGORD,.2))
Q
;
DRGQTY(DRGIEN,LOCTYP,LOCIEN) ; Get PADE quantity for drug DRGIEN for location LOCIEN
;
; Input: DRGIEN - Drug IEN pointer to DRUG (#50) file
; LOCTYP - Location Type - "WD"=Ward, "WG"=Ward Group, "CL"=Clinic, "CG"=Clinic Group
; LOCIEN - Location IEN, if LOCTYP="WD" : pointer to Ward (#42)
; if LOCTYP="WG" : Ward Group (#57.5)
; if LOCTYP="CL" : Clinic (#44)
; if LOCTYP="CG" : Clinic Group (#57.8)
;
N PSJPSYS,PSJDEV,PSJDRGCT,PSJCAB,PSJSUBFI
S PSJDRGCT="NA"
; Get proper location subfile in PADE DISPENSING DEVICE (#58.63)
S PSJSUBFI=$S(LOCTYP="WG":58.635,LOCTYP="WD":58.636,LOCTYP="CG":58.637,LOCTYP="CL":58.638,1:"")
; Bad location type
Q:'PSJSUBFI PSJDRGCT
; Get total sum of quantities of drug DRGIEN in each cabinet
S PSJCAB=0 F S PSJCAB=$O(^PS(58.601,"DRG",DRGIEN,PSJCAB)) Q:'PSJCAB D
.I $$CABLOC(PSJCAB,PSJSUBFI,+LOCIEN) S PSJDRGCT=PSJDRGCT+$$GETCABCT(PSJCAB,DRGIEN)
Q PSJDRGCT
;
CABLOC(PSJCAB,PSJSUBFI,LOCIEN) ; Return true if location LOCIEN is linked to cabinet PSJCAB
;
N CABLOC,CLINAM,PARTIAL,CABSTAT
; If PADE device is Inactive, return false
D GETS^DIQ(58.63,PSJCAB_",",4,"I","CABSTAT")
Q:$G(CABSTAT("58.63",PSJCAB_",",4,"I"))="I" ""
; Check if ward is directly linked to cabinet
D LIST^DIC(PSJSUBFI,","_+$G(PSJCAB)_",","@;.01","PI","","","","","I ^(0)="_+$G(LOCIEN),"","CABLOC")
S CABLOC=$S($G(CABLOC("DILIST",1,0)):1,1:0)
; If no match and looking for ward, check all wards linked to cabinet's ward groups
I 'CABLOC,($G(PSJSUBFI)=58.636) S CABLOC=$$CHKWG^PSJPAD50(PSJCAB,+LOCIEN)
; If no match and looking for clinic, check all clinics linked to cabinet's clinic groups
I 'CABLOC,($G(PSJSUBFI)=58.638) S CABLOC=$$CHKCG^PSJPAD50(PSJCAB,+LOCIEN) I 'CABLOC D
.; If no match and looking for clinic, check all clinic wildcards linked to cabinet
.D GETS^DIQ(44,+LOCIEN,".01",,"CLINAM") D
..S CLINAM=$G(CLINAM(44,+LOCIEN_",",".01")),PARTIAL=$E(CLINAM,1,2)
..F S PARTIAL=$O(^PS(58.63,"WC",PARTIAL)) Q:PARTIAL=""!$G(CABLOC) D
...Q:$E(PARTIAL,1,3)'=$E(CLINAM,1,3)
...Q:'($E(CLINAM,1,$L(PARTIAL))=PARTIAL)
...I $D(^PS(58.63,"WC",PARTIAL,PSJCAB)) S CABLOC=1
Q CABLOC
;
GETCABCT(CAB,DRG) ; Get PADE count of drug DRG for cabinet CAB
N SYSDA,DEVDA,DRGDA,CABCT,CABSTAT
S CABCT=0
S SYSDA=$O(^PS(58.601,"DRG",+$G(DRG),+$G(CAB),0)) Q:'SYSDA 0
S DEVDA=$O(^PS(58.601,"DRG",+$G(DRG),+$G(CAB),SYSDA,0)) Q:'DEVDA 0
S DRGDA=$O(^PS(58.601,"DRG",+$G(DRG),+$G(CAB),SYSDA,DEVDA,0)) Q:'DRGDA 0
;
D GETS^DIQ(58.60111,DRGDA_","_DEVDA_","_SYSDA_",",2,"","CABCT")
D GETS^DIQ(58.63,CAB_",",4,"I","CABSTAT")
Q:$G(CABSTAT("58.63",CAB_",",4,"I"))="I" ""
;
Q +$G(CABCT(58.60111,DRGDA_","_DEVDA_","_SYSDA_",",2))
;
PSJOE ; Set the PSJ PADE OE BALANCES kernel parameter
;
N PSJMSG,PSPARIEN,X,Y
N DIR,X,Y,PSYSTAT
S PSPARIEN=$$FIND1^DIC(8989.51,,,"PSJ PADE OE BALANCES")
Q:'PSPARIEN
S PSJMSG(0)=" "
S PSJMSG(1)="The PSJ PADE OE INDICATORS Parameter toggles the display of the"
S PSJMSG(2)="PADE flag (PD) in Inpatient Order Entry and the display of PADE"
S PSJMSG(3)="drug balances during entry of an order's Dispense Drug"
D EN^DDIOL(.PSJMSG)
S DIR("B")=$$GET^XPAR("SYS","PSJ PADE OE BALANCES")
I DIR("B") S DIR("B")=$$DEVSTCHK^PSJPDRU1(+$G(PSJPSYS))
S DIR("B")=$S(DIR("B")="":"",DIR("B")=1:"YES",1:"NO")
S DIR(0)="Y"
S DIR("A")="DISPLAY PADE INDICATORS IN IOE"
S DIR("?",1)=" This activates/deactivates PADE indicators in Inpatient"
S DIR("?")=" Order Entry (IOE) for this vendor only."
D ^DIR
S PSYSTAT=$S(Y=1:1,Y=0:0,1:"")
Q:PSYSTAT=""
;D DEVONOFF^PSJPDRU1(+$G(PSJPSYS),PSYSTAT) ;*362 - users want control over this via dispensing device edit
D INSYSPAR^PSJPDRU1(PSYSTAT)
Q
;
;CHG^XPAR(ENT,PAR,INST,VAL,ERR) ; change parameter value for a given instance
;EDIT(Entity,Parameter)
Q
;
PSJRFND(DFN,PSGORD,PSJLOC,PSJLOCTP,PSDRUG) ; Return a flag indicating all Dispense Drugs in the order are PADE drugs
;
N PSJPDCHK S PSJPDCHK=1
; Quit if patient/order location not linked to PADE
I $G(PSJLOCTP)="CL",$G(PSJLOC) S PSJPDCHK=$$PADECL^PSJPAD50(+$G(PSJLOC))
I $G(PSJLOCTP)="WD",$G(PSJLOC) S PSJPDCHK=$$PADEWD^PSJPAD50(+$G(PSJLOC))
Q:'$G(PSJPDCHK) ""
;
S (PSJNOTPD,PSJRFND)=0
S PSDDIEN=0 F Q:PSJNOTPD S PSDDIEN=$O(PSDRUG(PSDDIEN)) Q:'PSDDIEN!PSJNOTPD D
.N INACT,DDX S DDX=$O(^PS(53.45,+$G(PSJSYSP),2,"B",PSDDIEN,0)) I DDX S INACT=$P($G(^PS(53.45,+$G(PSJSYSP),2,DDX,0)),"^",3)
.Q:$G(INACT)&($G(INACT)<$P($$FMADD^XLFDT($$NOW^XLFDT,1),"."))
.S PSJRFND=$$DRGQTY(PSDDIEN,PSJLOCTP,PSJLOC)
.S:'(PSJRFND?1.N) PSJNOTPD=1
S:PSJNOTPD PSJRFND=""
Q PSJRFND
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSJPADSI 17957 printed Dec 13, 2024@02:08:38 Page 2
PSJPADSI ;BIR/JCH PADE INBOUND SYSTEM SET UP ;8/25/15
+1 ;;5.0;INPATIENT MEDICATIONS;**317,337,362,392**;16 DEC 97;Build 2
+2 ;
+3 ; Reference to EDIT^XPAREDIT is supported by DBIA 2336.
+4 ; Reference to WIN^DGPMDDCF is supported by DBIA 1246.
+5 ; Reference to INP^VADPT is supported by DBIA 10061.
+6 ; Reference to ^DDIOL is supported by DBIA 10142.
+7 ; Reference to ^PS(55 is supported by DBIA 2191.
+8 ; Reference to ^DIC(42 is supported by DBIA 10039.
+9 ; Reference to ^SC( is supported by DBIA 10040.
+10 ; Reference to NOW^XLFDT is supported by DBIA 10153.
+11 ;
+12 QUIT
+13 ;
ENCAB ; Setup Cabinet device in file 58.63
+1 NEW PSJPADQ
+2 FOR
if $GET(PSJPADQ)!$GET(DUOUT)!$GET(DTOUT)
QUIT
DO PADEV
+3 QUIT
+4 ;
PADEV ;enter/edit PADE devices and VistA locations
+1 NEW DR,DA,DIC,DIE,X,Y,PSJPSYS,PSJPDEV,PADAR,DEVDA
WRITE !
+2 SET PSJPSYS=""
+3 WRITE !
DO GETFILD(PSJPSYS,.DEVDA)
+4 IF '$GET(DEVDA)
SET PSJPADQ=1
QUIT
+5 IF $GET(DEVDA)
Begin DoDot:1
+6 IF $GET(DUOUT)!($GET(DTOUT))!$GET(PSJPADQ)
KILL DUOUT,DTOUT
QUIT
+7 SET DIE="^PS(58.63,"
SET DA=+DEVDA
SET DR="[PSJ PADE DISPENSING DEVICE]"
WRITE !
DO ^DIE
+8 if '$GET(DA)!$GET(DUOUT)!$GET(DTOUT)
QUIT
NEW PSJPDEV
SET PSJPDEV=DA
End DoDot:1
+9 KILL DIE,DIC
+10 QUIT
+11 ;
GETFILD(PSJPSYS,DEVIEN) ; Get Device if it exists, or File Device if not
+1 NEW PSJDIV,D
KILL DEVIEN,LAYGO
SET DEVIEN=""
+2 NEW DR,DIR,ERR,DEV,RESULT,TOT,RANGE,DEVPRMPT,PAD,PSJPNAM
+3 WRITE !
SET DIC="^PS(58.63,"
SET DIC(0)="EALNMV"
SET LAYGO="58.63"
SET DR="1"
+4 SET DR=1
SET DLAYGO=LAYGO
+5 DO ^DIC
KILL DIC
IF Y>0
SET DEVIEN=+Y
+6 ; If user aborted new device entry, may have left "?BAD" entry in 58.601 file due to invalid uniqueness key
IF Y<0
DO DELBADSY^PSJPDRU1
+7 IF $GET(DEVIEN)
IF $GET(PSJPSYS)
Begin DoDot:1
+8 NEW FDA
SET FDA(58.63,DA,1)=PSJPSYS
+9 SET FDA(58.63,DA,12)=$$UPPER^PSJPDRUT($PIECE($GET(^PS(58.63,+DEVIEN,0)),"^"))
+10 DO FILE^DIE("","FDA","RESULT")
End DoDot:1
+11 QUIT
+12 ;
ENSYS ; Setup PADE Inbound System in file 58.601
+1 NEW PSJPADQ
+2 FOR
if $GET(PSJPADQ)!$GET(DUOUT)!$GET(DTOUT)
QUIT
DO PADESYS
+3 QUIT
+4 ;
PADESYS ;enter/edit PADE inventory system
+1 NEW DR,DA,DIC,DIE,X,Y,PSJPSYS,PSJPDEV,PADAR,DEVDA,PSJPSNM,DLAYGO,PSJASKDN
WRITE !
+2 SET Y=$$ENSYS^PSJPDRUT
+3 if $GET(DUOUT)!$GET(DTOUT)
QUIT
+4 IF Y<1
SET PSJPADQ=1
QUIT
+5 SET (DA,PSJPSYS)=+Y
+6 SET DIE="^PS(58.601,"
SET DR="[PSJ PADE INVENTORY]"
DO ^DIE
+7 SET PSJPSNM=$PIECE($GET(^PS(58.601,+$GET(PSJPSYS),0)),"^")
+8 IF PSJPSNM=""!($GET(PSJASKDN)=3)
SET PSJPADQ=1
QUIT
+9 FOR
if $GET(PSJPADQ)!$GET(DUOUT)!$GET(DTOUT)
QUIT
DO GETDEV(PSJPSYS,.DEVDA)
IF $GET(DEVDA)
Begin DoDot:1
+10 IF $GET(DUOUT)!($GET(DTOUT))!$GET(PSJPADQ)
KILL DUOUT,DTOUT
QUIT
+11 NEW DIE,DA,DR,X,Y
+12 SET DIE="^PS(58.63,"
SET DA=+DEVDA
SET DR="[PSJ PADE DISPENSING DEVICE]"
WRITE !
DO ^DIE
+13 WRITE !!
SET DIR(0)="FO"
SET DIR("A")="Press return to continue"
DO ^DIR
QUIT
End DoDot:1
+14 KILL DIE,DIC,DTOUT,DUOUT,PSJPADQ
+15 QUIT
+16 ;
GETDEV(PSJPSYS,DEVIEN) ; Get device ien
+1 NEW PSJDIV
KILL DEVIEN
SET DEVIEN=""
+2 NEW DIR,ERR,DEV,RESULT,TOT,RANGE,DEVPRMPT,PAD,PSJPNAM
+3 WRITE !
SET DIC="^PS(58.63,"
SET DIC(0)="EAMV"
+4 DO ^DIC
KILL DIC
IF Y>0
SET DEVIEN=+Y
+5 IF $GET(DEVIEN)
IF $GET(PSJPSYS)
Begin DoDot:1
+6 NEW FDA
SET FDA(58.63,DEVIEN_",",1)=PSJPSYS
+7 SET FDA(58.63,DEVIEN_",",12)=$$UPPER^PSJPDRUT($PIECE($GET(^PS(58.63,+DEVIEN,0)),"^"))
+8 DO FILE^DIE("","FDA","RESULT")
End DoDot:1
+9 if '$GET(DEVIEN)>0
SET PSJPADQ=1
+10 QUIT
+11 ;
WARDSCR(Y) ; Ward Location Y must be associated with division PSJDIV in PADE inbound system DA(3)
+1 NEW D0,X
+2 SET D0=+Y
DO WIN^DGPMDDCF
if $GET(X)
QUIT 1
+3 IF $PIECE(^DIC(42,D0,0),U,11)=$GET(^PS(58.601,DA(3),"DIV",DA(2),0))
QUIT 1
+4 QUIT 0
+5 ;
WARDSCR2(Y,DDEV) ; Ward Location Y must be associated with division PSJDIV in PADE inbound system DA(3)
+1 NEW D0,X,DIV
+2 SET D0=+Y
+3 if '$GET(DDEV)
QUIT 0
+4 SET DIV=$PIECE($GET(^PS(58.63,+DDEV,2)),"^")
+5 if 'DIV
QUIT 0
+6 IF $PIECE(^DIC(42,D0,0),U,11)=DIV
QUIT 1
+7 QUIT 0
+8 ;
CLCHK(QZ) ; Clinic Location QZ must be associated with division PSJDIV in PADE inbound system DA(3)
+1 NEW PSJDIV
SET PSJDIV=$GET(^PS(58.601,DA(3),"DIV",DA(2),0))
+2 IF $PIECE(^SC(QZ,0),U,3)'="C"
QUIT 0
+3 IF $PIECE(^SC(QZ,0),U,15)'=PSJDIV
QUIT 0
+4 QUIT 1
+5 ;
CLCHK2(QZ,DDEV) ; Clinic Location QZ must be associated with division PSJDIV in PADE inbound system DA(3)
+1 NEW PSJDIV
+2 if '$GET(DDEV)
QUIT 0
+3 SET PSJDIV=$PIECE($GET(^PS(58.63,+DDEV,2)),"^")
+4 if 'PSJDIV
QUIT 0
+5 IF $PIECE(^SC(QZ,0),U,3)'="C"
QUIT 0
+6 IF $PIECE(^SC(QZ,0),U,15)'=PSJDIV
QUIT 0
+7 QUIT 1
+8 ;
CGCHK(QZ) ; Clinic Group QZ must have at least one clinic associated with division PSJDIV in PADE inbound system DA(3)
+1 NEW PSJDIV,CL,CLIEN,GOTONE
SET PSJDIV=$GET(^PS(58.601,DA(3),"DIV",DA(2),0))
+2 SET GOTONE=0
+3 SET CL=0
FOR
if $GET(GOTONE)
QUIT
SET CL=$ORDER(^PS(57.8,+QZ,1,CL))
if 'CL
QUIT
Begin DoDot:1
+4 SET CLIEN=+$GET(^PS(57.8,+QZ,1,CL,0))
+5 IF $PIECE(^SC(CLIEN,0),U,15)=PSJDIV
SET GOTONE=1
End DoDot:1
+6 if GOTONE
QUIT 1
+7 QUIT 0
+8 ;
CGCHK2(QZ,DDEV) ; Clinic Group QZ must have at least one clinic associated with division PSJDIV in PADE inbound system DA(3)
+1 NEW PSJDIV,CL,CLIEN,GOTONE
+2 if '$GET(DDEV)
QUIT 0
+3 SET PSJDIV=$PIECE($GET(^PS(58.63,+DDEV,2)),"^")
+4 if 'PSJDIV
QUIT 0
+5 SET GOTONE=0
+6 SET CL=0
FOR
if $GET(GOTONE)
QUIT
SET CL=$ORDER(^PS(57.8,+QZ,1,CL))
if 'CL
QUIT
Begin DoDot:1
+7 SET CLIEN=+$GET(^PS(57.8,+QZ,1,CL,0))
+8 IF $PIECE(^SC(CLIEN,0),U,15)=PSJDIV
SET GOTONE=1
End DoDot:1
+9 if GOTONE
QUIT 1
+10 QUIT 0
+11 ;
WGCHK(QZ) ; Ward Group QZ must have at least one ward associated with division PSJDIV in PADE inbound system DA(3)
+1 NEW PSJDIV,WD,WDIEN,GOTONE
SET PSJDIV=$GET(^PS(58.601,DA(3),"DIV",DA(2),0))
+2 SET GOTONE=0
+3 SET WD=0
FOR
if $GET(GOTONE)
QUIT
SET WD=$ORDER(^PS(57.5,+QZ,1,WD))
if 'WD
QUIT
Begin DoDot:1
+4 SET WDIEN=+$GET(^PS(57.5,+QZ,1,WD,0))
+5 IF $PIECE(^DIC(42,WDIEN,0),U,11)=PSJDIV
SET GOTONE=1
End DoDot:1
+6 if GOTONE
QUIT 1
+7 QUIT 0
+8 ;
WGCHK2(QZ,DDEV) ; Ward Group QZ must have at least one ward associated with division PSJDIV in PADE inbound system DA(3)
+1 NEW PSJDIV,WD,WDIEN,GOTONE
+2 if '$GET(DDEV)
QUIT 0
+3 SET PSJDIV=$PIECE($GET(^PS(58.63,+DDEV,2)),"^")
+4 if 'PSJDIV
QUIT 0
+5 SET GOTONE=0
+6 SET WD=0
FOR
if $GET(GOTONE)
QUIT
SET WD=$ORDER(^PS(57.5,+QZ,1,WD))
if 'WD
QUIT
Begin DoDot:1
+7 SET WDIEN=+$GET(^PS(57.5,+QZ,1,WD,0))
+8 IF $PIECE(^DIC(42,WDIEN,0),U,11)=PSJDIV
SET GOTONE=1
End DoDot:1
+9 if GOTONE
QUIT 1
+10 QUIT 0
+11 ;
SYSHLP ; User help for PADE INVENTORY SYSTEM (#.01) field of PADE INVENTORY SYSTEM (#58.601) file
+1 NEW ARRAY
+2 SET ARRAY(1)=" Enter the name of the Pharmacy Automated Dispensing Equipment (PADE)."
+3 SET ARRAY(2)=" system. This must be the same as the System Name in the HL7 messages"
+4 SET ARRAY(3)=" received from the PADE vendor interface."
+5 SET ARRAY(4)=""
+6 DO WRITE(.ARRAY)
+7 QUIT
+8 ;
DDEVHLP ; User help for DISPENSING DEVICE (#1) field of PADE INVENTORY SYSTEM (#58.601) file
+1 NEW ARRAY
+2 SET ARRAY(1)=" Enter the name of the specific dispensing device, also known as"
+3 SET ARRAY(2)=" a Station or Cabinet. This must match exactly the name of the"
+4 SET ARRAY(3)=" device on the PADE system."
+5 SET ARRAY(4)=""
+6 DO WRITE(.ARRAY)
+7 QUIT
+8 ;
CBALHLP ; User help for CALCULATED DEVICE BALANCE (#1) field in DRUG (DEVICE) (#58.60111) sub-file.
+1 NEW ARRAY
+2 SET ARRAY(1)=" CAUTION: The Calculated Device Balance is calculated using information"
+3 SET ARRAY(2)=" received from the dispensing system. Verify the balance on the dispensing"
+4 SET ARRAY(3)=" device before making edits to this field."
+5 SET ARRAY(4)=""
+6 DO WRITE(.ARRAY)
+7 QUIT
RBALHLP ; User help for REPORTED DEVICE BALANCE (#2) field in DRUG (DEVICE) (#58.60111) sub-file.
+1 NEW ARRAY
+2 SET ARRAY(1)=" CAUTION: The Reported Device Balance is received directly from the"
+3 SET ARRAY(2)=" dispensing system. Verify the balance on the dispensing device before"
+4 SET ARRAY(3)=" making edits to this field, or correct the balance on the PADE system."
+5 SET ARRAY(4)=""
+6 DO WRITE(.ARRAY)
+7 QUIT
+8 ;
DRGINHLP ; User help for INACTIVE DATE/TIME (#3) field in the DRUG (DEVICE) (#58.60111) sub-file.
+1 NEW ARRAY
+2 SET ARRAY(1)=" Enter the Date/Time a drug was completely removed from the device,"
+3 SET ARRAY(2)=" indicating the drug will no longer be available from that device."
+4 SET ARRAY(3)=""
+5 DO WRITE(.ARRAY)
+6 QUIT
+7 ;
DIVHLP ; User help for DIVISION (#3) field, sub-file 58.6013.
+1 NEW ARRAY
+2 SET ARRAY(1)=" Enter a Medical Center Division associated with this PADE inbound system."
+3 SET ARRAY(2)=" PADE dispensing devices may be associated with Divisions so that PADE"
+4 SET ARRAY(3)=" inventory may be updated accurately in VistA."
+5 SET ARRAY(4)=""
+6 DO WRITE(.ARRAY)
+7 QUIT
+8 ;
WRITE(ARRAY) ; Write contents of ARRAY to screen
+1 DO EN^DDIOL(.ARRAY)
+2 QUIT
+3 ;
DWOIN(DWOTIM) ; Input Transform-Dispensed without orders-length of time after dispense that order creation is allowed
+1 NEW DWOVAL,UNIT,MULT,NUM
+2 SET NUM=+DWOTIM
+3 SET UNIT=$EXTRACT($PIECE(DWOTIM,NUM,2))
+4 if '$GET(DWOTIM)
QUIT 0
+5 SET MULT=$SELECT(UNIT="H":60,UNIT="D":1440,UNIT="M":1,UNIT="S":1/60,1:1)
+6 SET DWOVAL=DWOTIM*MULT
+7 QUIT $$ROUND(DWOVAL)
+8 ;
ROUND(NUM) ; Round
+1 if 'NUM
QUIT 0
+2 NEW DIV,REM
+3 SET DIV=NUM\1
SET REM=NUM#1
+4 SET DIV=$SELECT(REM<.5:DIV,1:DIV+1)
+5 QUIT DIV
+6 ;
ASKDONE() ; Ask next action
+1 NEW DIR,PSJSNAM,X,Y
+2 SET PSJSNAM=$PIECE($GET(^PS(58.601,+$GET(PSJPSYS),0)),"^")
+3 SET DIR(0)="S^R:Re-edit "_PSJSNAM_" System;D:Edit "_$SELECT(PSJSNAM]"":PSJSNAM_" ",1:"")_"PADE Devices;Q:Quit"
+4 SET DIR("A",1)="Finished editing PADE System "_PSJSNAM
+5 SET DIR("A")="(R)e-edit PADE system, edit (D)evice, or (Q)uit (R,D,Q)"
+6 DO ^DIR
SET PSJASKDN=$SELECT(Y="R":1,Y="D":2,1:3)
+7 QUIT PSJASKDN
+8 ;
DWODEV(CABNUM) ; Prompt for Dispensed Without Orders Mail Group for Device CABINET
+1 NEW DIC,DA,DR,X,Y,DIE,DR,CABNAME,PSJPSYS,DWOIEN,DP,DL,DI
+2 if '$GET(CABNUM)
QUIT
+3 DO GETS^DIQ(58.63,+CABNUM,".01;1","IE","CABNAME")
+4 SET CABNAME=$GET(CABNAME(58.63,CABNUM_",",.01,"E"))
+5 SET PSJPSYS=$GET(CABNAME(58.63,CABNUM_",",1,"I"))
+6 if (CABNAME="")
QUIT
+7 SET DWOIEN=$$FIND1^DIC(58.6014,","_+$GET(PSJPSYS)_",","","PC."_CABNAME)
+8 IF 'DWOIEN
Begin DoDot:1
+9 NEW DIC,DA,DR,X,Y,DIE,DR,DP,DL,DO,DI
+10 SET DIC="^PS(58.601,"_PSJPSYS_",2,"
SET DIC(0)="ZL"
SET DIC("P")="58.6014V"
+11 SET DA(1)=PSJPSYS
SET X=CABNUM_";PS(58.63,"
+12 DO FILE^DICN
IF Y>0
SET DWOIEN=+Y
End DoDot:1
if 'DWOIEN
QUIT
+13 if 'DWOIEN
QUIT
+14 WRITE !
DO EN^DDIOL("DWO ENTITY: "_CABNAME)
+15 SET DIE="^PS(58.601,"_PSJPSYS_",2,"
SET DA=+DWOIEN
SET DA(1)=+PSJPSYS
SET DR="1"
DO ^DIE
+16 QUIT
+17 ;
DRGFLAG(DFN,PSGORD,PSJDFLOC,ON,PSJNEWOE) ; Get flag indicating order is PADE order
+1 NEW PSJPSYS,PSJDRGCT,PSJLOC,PSJDSTK,PSJLOCTP,PSDRGTOT,PSDRUG,PSJRFND,X,Y,PSJNOTPD
+2 ; If new order, no order number passed in
IF '$GET(PSGORD)
IF $GET(PSJNEWOE)
IF $GET(ON)["P"
NEW PSGORD
SET PSGORD=$GET(ON)
+3 ; Patient DFN and order PSGORD are required, quit if not passed
+4 if '$GET(DFN)!'$GET(PSGORD)
QUIT ""
+5 ;
+6 SET PSJRFND=0
+7 ; Unit Dose Active, Pending, Non-Verified
+8 IF PSGORD["U"!(PSGORD["P")
Begin DoDot:1
+9 IF $SELECT(PSGORD["U":'$DATA(^PS(55,+$GET(DFN),5,+$GET(PSGORD),1)),1:'$DATA(^PS(53.1,+PSGORD,1)))
SET PSJRFND=""
QUIT
+10 NEW PSDDIEN
+11 if PSGORD["U"
DO GETUDRG(DFN,PSGORD,.PSJLOC,.PSJLOCTP,.PSDRUG)
+12 if PSGORD["P"
DO GETPDRG(DFN,PSGORD,.PSJLOC,.PSJLOCTP,.PSDRUG)
+13 SET PSJRFND=$$PSJRFND(DFN,PSGORD,.PSJLOC,.PSJLOCTP,.PSDRUG)
End DoDot:1
QUIT PSJRFND
+14 ;
+15 ; Complex orders
+16 IF PSGORD=+PSGORD
Begin DoDot:1
+17 NEW PSJPRNT
SET PSJPRNT=+PSGORD
+18 SET PSGORD=0
FOR
SET PSGORD=$ORDER(^PS(53.1,"ACX",PSJPRNT,PSGORD))
if 'PSGORD!$GET(PSJRFND)
QUIT
Begin DoDot:2
+19 if '$DATA(^PS(53.1,+PSGORD,0))
QUIT
NEW PSDDIEN
+20 DO GETPDRG(DFN,PSGORD_"P",.PSJLOC,.PSJLOCTP,.PSDRUG)
+21 SET PSJRFND=$$PSJRFND(DFN,PSGORD_"P",.PSJLOC,.PSJLOCTP,.PSDRUG)
End DoDot:2
End DoDot:1
QUIT PSJRFND
+22 ;
+23 QUIT PSJRFND
+24 ;
DRGSTOCK(DFN,PSGORD,PSJDFLOC,PS5345,DRGIEN) ; Get Quantity of Drug in PADE for patient DFN order PSGORD
+1 ; PSGORD = Clinic Order - find PADEs associated with the Clinic, return total quantity in all qualifying PADEs
+2 ; PSGORD = Regular UD order - find PADEs associated with patient's ward location, return total quantity in all PADEs
+3 ;
+4 NEW PSJPSYS,PSJDRGCT,PSJLOC,PSJDSTK,PSJLOCTP,PSDRGTOT,PSDRUG,PSDRFND,X,Y,PSJNOTPD
+5 SET PSJDSTK=""
SET PSDRGTOT=0
+6 ; Patient DFN and order PSGORD are required, quit if not passed
+7 IF '$GET(DFN)
QUIT ""
+8 IF '$GET(PSGORD)
Begin DoDot:1
+9 SET PSGORD=""
+10 IF '$GET(PSJDFLOC)
Begin DoDot:2
+11 IF '$GET(VAIN(4))
NEW VAIN
DO INP^VADPT
+12 SET PSJDFLOC=+$GET(VAIN(4))_"WD"
End DoDot:2
+13 SET PSJLOCTP=$PIECE(PSJDFLOC,+PSJDFLOC,2)
if PSJLOCTP=""
QUIT
+14 SET PSJLOC=+$GET(PSJDFLOC)
End DoDot:1
IF '$GET(DRGIEN)!'$GET(PSJLOC)
QUIT ""
+15 ;
+16 ;Get location and default drug ien for Active UD and NON-VERIFIED/PENDING UD order.
+17 ; If a specific drug was passed in via DRGIEN or PS5345 skip this and find balance for that drug
+18 IF PSGORD["U"!(PSGORD["P")
SET PSDRFND=""
Begin DoDot:1
+19 if $SELECT(PSGORD["U"
QUIT
+20 NEW PSDDIEN
+21 if PSGORD["U"
DO GETUDRG(DFN,PSGORD,.PSJLOC,.PSJLOCTP,.PSDRUG)
+22 if PSGORD["P"
DO GETPDRG(DFN,PSGORD,.PSJLOC,.PSJLOCTP,.PSDRUG)
End DoDot:1
if PSDRFND]""
QUIT PSDRFND
+23 ;
+24 ; If pointer to DISPENSE DRUG multiple (#2) in INPATIENT USER PARAMETERS (#53.45) file is passed, get default drug ien
+25 IF $GET(PS5345)
NEW TMP
SET TMP=+$GET(^PS(53.45,+$GET(PSJSYSP),2,+$GET(PS5345),0))
IF $GET(TMP)
SET PSDRUG=TMP
+26 ; If a specific drug ien pointer to DRUG file (#50) is passed in, use that
+27 IF $GET(DRGIEN)
SET PSDRUG=+DRGIEN
+28 ;
+29 IF '$GET(PSDRUG)
QUIT "NA"
+30 ;
+31 SET PSDRGTOT=$$DRGQTY(PSDRUG,PSJLOCTP,PSJLOC)
+32 QUIT PSDRGTOT
+33 ;
GETUDRG(DFN,PSGORD,PSJLOC,PSJLOCTP,PSDRUG) ; Get UD order location and drug from UD multiple (#62) of PHARMACY PATIENT file (#55)
+1 ;
+2 KILL PSJLOC,PSJLOCTP,PSDRUG
NEW DDCNT,TMPDRG,TMPLOC
+3 SET DDCNT=0
FOR
SET DDCNT=$ORDER(^PS(55,+$GET(DFN),5,+PSGORD,1,DDCNT))
if 'DDCNT
QUIT
Begin DoDot:1
+4 SET TMPDRG=+$GET(^PS(55,+DFN,5,+PSGORD,1,DDCNT,0))
+5 if TMPDRG
SET PSDRUG(TMPDRG)=""
+6 if '$GET(PSDRUG)
SET PSDRUG=TMPDRG
End DoDot:1
+7 SET TMPLOC=$GET(^PS(55,+DFN,5,+PSGORD,8))
SET PSJLOCTP="CL"
SET PSJLOC=$SELECT(+TMPLOC&$PIECE(TMPLOC,"^",2):+TMPLOC,1:"")
+8 IF 'PSJLOC
NEW VAIN,VAINDT,VAHOW,VAROOT
DO INP^VADPT
SET PSJLOC=$GET(VAIN(4))
SET PSJLOCTP="WD"
+9 QUIT
+10 ;
GETPDRG(DFN,PSGORD,PSJLOC,PSJLOCTP,PSDRUG) ; Get UD order location and drug from NON VERIFIED/PENDING file (#53.1)
+1 ;
+2 KILL PSJLOC,PSJLOCTP,PSDRUG
NEW DDCNT,TMPDRG,TMPLOC
+3 SET DDCNT=0
FOR
SET DDCNT=$ORDER(^PS(53.1,+PSGORD,1,DDCNT))
if 'DDCNT
QUIT
Begin DoDot:1
+4 SET TMPDRG=+$GET(^PS(53.1,+PSGORD,1,DDCNT,0))
+5 if TMPDRG
SET PSDRUG(TMPDRG)=""
+6 if '$GET(PSDRUG)
SET PSDRUG=TMPDRG
End DoDot:1
+7 SET TMPLOC=$GET(^PS(53.1,+PSGORD,"DSS"))
SET PSJLOCTP="CL"
SET PSJLOC=$SELECT(+TMPLOC&$PIECE(TMPLOC,"^",2):+TMPLOC,1:"")
+8 IF 'PSJLOC
NEW VAIN
DO INP^VADPT
SET PSJLOC=$GET(VAIN(4))
SET PSJLOCTP="WD"
+9 IF $DATA(PSDRUG)<10
Begin DoDot:1
+10 NEW PSJOI
SET PSJOI=+$GET(^PS(53.1,+PSGORD,.2))
End DoDot:1
+11 QUIT
+12 ;
DRGQTY(DRGIEN,LOCTYP,LOCIEN) ; Get PADE quantity for drug DRGIEN for location LOCIEN
+1 ;
+2 ; Input: DRGIEN - Drug IEN pointer to DRUG (#50) file
+3 ; LOCTYP - Location Type - "WD"=Ward, "WG"=Ward Group, "CL"=Clinic, "CG"=Clinic Group
+4 ; LOCIEN - Location IEN, if LOCTYP="WD" : pointer to Ward (#42)
+5 ; if LOCTYP="WG" : Ward Group (#57.5)
+6 ; if LOCTYP="CL" : Clinic (#44)
+7 ; if LOCTYP="CG" : Clinic Group (#57.8)
+8 ;
+9 NEW PSJPSYS,PSJDEV,PSJDRGCT,PSJCAB,PSJSUBFI
+10 SET PSJDRGCT="NA"
+11 ; Get proper location subfile in PADE DISPENSING DEVICE (#58.63)
+12 SET PSJSUBFI=$SELECT(LOCTYP="WG":58.635,LOCTYP="WD":58.636,LOCTYP="CG":58.637,LOCTYP="CL":58.638,1:"")
+13 ; Bad location type
+14 if 'PSJSUBFI
QUIT PSJDRGCT
+15 ; Get total sum of quantities of drug DRGIEN in each cabinet
+16 SET PSJCAB=0
FOR
SET PSJCAB=$ORDER(^PS(58.601,"DRG",DRGIEN,PSJCAB))
if 'PSJCAB
QUIT
Begin DoDot:1
+17 IF $$CABLOC(PSJCAB,PSJSUBFI,+LOCIEN)
SET PSJDRGCT=PSJDRGCT+$$GETCABCT(PSJCAB,DRGIEN)
End DoDot:1
+18 QUIT PSJDRGCT
+19 ;
CABLOC(PSJCAB,PSJSUBFI,LOCIEN) ; Return true if location LOCIEN is linked to cabinet PSJCAB
+1 ;
+2 NEW CABLOC,CLINAM,PARTIAL,CABSTAT
+3 ; If PADE device is Inactive, return false
+4 DO GETS^DIQ(58.63,PSJCAB_",",4,"I","CABSTAT")
+5 if $GET(CABSTAT("58.63",PSJCAB_",",4,"I"))="I"
QUIT ""
+6 ; Check if ward is directly linked to cabinet
+7 DO LIST^DIC(PSJSUBFI,","_+$GET(PSJCAB)_",","@;.01","PI","","","","","I ^(0)="_+$GET(LOCIEN),"","CABLOC")
+8 SET CABLOC=$SELECT($GET(CABLOC("DILIST",1,0)):1,1:0)
+9 ; If no match and looking for ward, check all wards linked to cabinet's ward groups
+10 IF 'CABLOC
IF ($GET(PSJSUBFI)=58.636)
SET CABLOC=$$CHKWG^PSJPAD50(PSJCAB,+LOCIEN)
+11 ; If no match and looking for clinic, check all clinics linked to cabinet's clinic groups
+12 IF 'CABLOC
IF ($GET(PSJSUBFI)=58.638)
SET CABLOC=$$CHKCG^PSJPAD50(PSJCAB,+LOCIEN)
IF 'CABLOC
Begin DoDot:1
+13 ; If no match and looking for clinic, check all clinic wildcards linked to cabinet
+14 DO GETS^DIQ(44,+LOCIEN,".01",,"CLINAM")
Begin DoDot:2
+15 SET CLINAM=$GET(CLINAM(44,+LOCIEN_",",".01"))
SET PARTIAL=$EXTRACT(CLINAM,1,2)
+16 FOR
SET PARTIAL=$ORDER(^PS(58.63,"WC",PARTIAL))
if PARTIAL=""!$GET(CABLOC)
QUIT
Begin DoDot:3
+17 if $EXTRACT(PARTIAL,1,3)'=$EXTRACT(CLINAM,1,3)
QUIT
+18 if '($EXTRACT(CLINAM,1,$LENGTH(PARTIAL))=PARTIAL)
QUIT
+19 IF $DATA(^PS(58.63,"WC",PARTIAL,PSJCAB))
SET CABLOC=1
End DoDot:3
End DoDot:2
End DoDot:1
+20 QUIT CABLOC
+21 ;
GETCABCT(CAB,DRG) ; Get PADE count of drug DRG for cabinet CAB
+1 NEW SYSDA,DEVDA,DRGDA,CABCT,CABSTAT
+2 SET CABCT=0
+3 SET SYSDA=$ORDER(^PS(58.601,"DRG",+$GET(DRG),+$GET(CAB),0))
if 'SYSDA
QUIT 0
+4 SET DEVDA=$ORDER(^PS(58.601,"DRG",+$GET(DRG),+$GET(CAB),SYSDA,0))
if 'DEVDA
QUIT 0
+5 SET DRGDA=$ORDER(^PS(58.601,"DRG",+$GET(DRG),+$GET(CAB),SYSDA,DEVDA,0))
if 'DRGDA
QUIT 0
+6 ;
+7 DO GETS^DIQ(58.60111,DRGDA_","_DEVDA_","_SYSDA_",",2,"","CABCT")
+8 DO GETS^DIQ(58.63,CAB_",",4,"I","CABSTAT")
+9 if $GET(CABSTAT("58.63",CAB_",",4,"I"))="I"
QUIT ""
+10 ;
+11 QUIT +$GET(CABCT(58.60111,DRGDA_","_DEVDA_","_SYSDA_",",2))
+12 ;
PSJOE ; Set the PSJ PADE OE BALANCES kernel parameter
+1 ;
+2 NEW PSJMSG,PSPARIEN,X,Y
+3 NEW DIR,X,Y,PSYSTAT
+4 SET PSPARIEN=$$FIND1^DIC(8989.51,,,"PSJ PADE OE BALANCES")
+5 if 'PSPARIEN
QUIT
+6 SET PSJMSG(0)=" "
+7 SET PSJMSG(1)="The PSJ PADE OE INDICATORS Parameter toggles the display of the"
+8 SET PSJMSG(2)="PADE flag (PD) in Inpatient Order Entry and the display of PADE"
+9 SET PSJMSG(3)="drug balances during entry of an order's Dispense Drug"
+10 DO EN^DDIOL(.PSJMSG)
+11 SET DIR("B")=$$GET^XPAR("SYS","PSJ PADE OE BALANCES")
+12 IF DIR("B")
SET DIR("B")=$$DEVSTCHK^PSJPDRU1(+$GET(PSJPSYS))
+13 SET DIR("B")=$SELECT(DIR("B")="":"",DIR("B")=1:"YES",1:"NO")
+14 SET DIR(0)="Y"
+15 SET DIR("A")="DISPLAY PADE INDICATORS IN IOE"
+16 SET DIR("?",1)=" This activates/deactivates PADE indicators in Inpatient"
+17 SET DIR("?")=" Order Entry (IOE) for this vendor only."
+18 DO ^DIR
+19 SET PSYSTAT=$SELECT(Y=1:1,Y=0:0,1:"")
+20 if PSYSTAT=""
QUIT
+21 ;D DEVONOFF^PSJPDRU1(+$G(PSJPSYS),PSYSTAT) ;*362 - users want control over this via dispensing device edit
+22 DO INSYSPAR^PSJPDRU1(PSYSTAT)
+23 QUIT
+24 ;
+25 ;CHG^XPAR(ENT,PAR,INST,VAL,ERR) ; change parameter value for a given instance
+26 ;EDIT(Entity,Parameter)
+27 QUIT
+28 ;
PSJRFND(DFN,PSGORD,PSJLOC,PSJLOCTP,PSDRUG) ; Return a flag indicating all Dispense Drugs in the order are PADE drugs
+1 ;
+2 NEW PSJPDCHK
SET PSJPDCHK=1
+3 ; Quit if patient/order location not linked to PADE
+4 IF $GET(PSJLOCTP)="CL"
IF $GET(PSJLOC)
SET PSJPDCHK=$$PADECL^PSJPAD50(+$GET(PSJLOC))
+5 IF $GET(PSJLOCTP)="WD"
IF $GET(PSJLOC)
SET PSJPDCHK=$$PADEWD^PSJPAD50(+$GET(PSJLOC))
+6 if '$GET(PSJPDCHK)
QUIT ""
+7 ;
+8 SET (PSJNOTPD,PSJRFND)=0
+9 SET PSDDIEN=0
FOR
if PSJNOTPD
QUIT
SET PSDDIEN=$ORDER(PSDRUG(PSDDIEN))
if 'PSDDIEN!PSJNOTPD
QUIT
Begin DoDot:1
+10 NEW INACT,DDX
SET DDX=$ORDER(^PS(53.45,+$GET(PSJSYSP),2,"B",PSDDIEN,0))
IF DDX
SET INACT=$PIECE($GET(^PS(53.45,+$GET(PSJSYSP),2,DDX,0)),"^",3)
+11 if $GET(INACT)&($GET(INACT)<$PIECE($$FMADD^XLFDT($$NOW^XLFDT,1),"."))
QUIT
+12 SET PSJRFND=$$DRGQTY(PSDDIEN,PSJLOCTP,PSJLOC)
+13 if '(PSJRFND?1.N)
SET PSJNOTPD=1
End DoDot:1
+14 if PSJNOTPD
SET PSJRFND=""
+15 QUIT PSJRFND
