- 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 Feb 18, 2025@23:35:01 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