Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PSJPADSI

PSJPADSI.m

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