PSBVDLIV ;BIRMINGHAM/EFC-BCMA IV VIRTUAL DUE LIST ;03/06/16 3:06pm
;;3.0;BAR CODE MED ADMIN;**6,38,32,58,70,83,106**;Mar 2004;Build 43
;Per VHA Directive 2004-038 (or future revisions regarding same), this routine should not be modified.
;
; Reference/IA
; EN^PSJBCMA/2828
; EN^PSJBCMA1/2829
; GETPROVL^PSGSICH1/5653
; INTRDIC^PSGSICH1/5654
;
;*58 - add 29th piece to Results for Override/Intervention flag 1/0
;*70 - add 32nd piece to Results for Clinic Order name
; - add 33rd piece to Results for Clinic ien ptr to file #44
;*83 - Clinic Orders should show up on VDL's when start order date
; is Today now ignores the time portion of that field.
;*106- add Hazardous to Handle & Dispose flags 36 & 37
;
EN(DFN,PSBDT) ; Default Order List Return for Today
;
; RPC: PSB GETORDERLIST
;
; Description:
; Returns the current IV order set for today to display on the
; client VDL
;
N PSBDATA,PSBTBOUT,PSBDOADD,PSBDT2,X,PSHIST ;*70
S PSBTBOUT=0,PSBDOADD=0
S:PSBTAB="IVTAB" PSBDOADD=1
;
; Passing PSBDT as 3rd parameter turns off the V.1.0 One-Time lookback
K ^TMP("PSJ",$J),^TMP("PSB",$J,"ON IVTAB")
S PSBHIST=$S(PSBCLINORD:-7,1:-3) ;*70 default hist days back
S X1=PSBDT,X2=PSBHIST D C^%DTC S PSBDT2=X ;*70
D EN^PSJBCMA(DFN,PSBDT2,PSBDT)
;Filter in/out Clinic Orders ;*70
D:PSBCLINORD INCLUDCO^PSBVDLU1
D:'PSBCLINORD REMOVECO^PSBVDLU1
;
I $G(^TMP("PSJ",$J,1,0))=-1 Q ; No orders
;
F PSBX=0:0 S PSBX=$O(^TMP("PSJ",$J,PSBX)) Q:('PSBX)!(PSBTBOUT) D
.N PSBRTNOW S PSBRTNOW=$$NOW^XLFDT()
.D CLEAN^PSBVT,PSJ^PSBVT(PSBX)
.;
.; << Standard checks for ALL orders >>
.;
.Q:PSBONX'["V" ; IVs only
.Q:PSBIVT["P" ; No piggybacks
.Q:PSBONX["P" ; No Pending Orders
.Q:('PSBCLINORD)&(PSBOST>($$FMADD^XLFDT($$NOW^XLFDT,,,$$GET^XPAR("DIV","PSB ADMIN BEFORE")))) ;*70 don't check this for CO's
.;CO Order future start check now based on the date only Not time *83
.Q:($G(PSBCLORD)]"")&($P(PSBOST,".")>$P(PSBRTNOW,"."))
.;
.; Need to see if "last order" in chain is active/not pending.
.S PSBFON1=PSBFON,PSBLOOP=0 I $G(PSBFON)]"" S PSBLACTV=$S($G(PSBFON)["P":0,1:1) S PSBFON2=$G(PSBFON) I 'PSBLACTV F D Q:($G(PSBFON)="")!($G(PSBFON1)=$G(PSBFON2))!(PSBLOOP)!(PSBLACTV) ;
..I $G(PSBFON)["P" K ^TMP("PSJ1",$J) D EN^PSJBCMA1(DFN,PSBFON2,1) I ^TMP("PSJ1",$J,0)=-1 S PSBFON=""
..D:$G(PSBFON)["" CLEAN^PSBVT,PSJ1^PSBVT(DFN,PSBFON2)
..I PSBFON=PSBFON2 S PSBLOOP=1,PSBLACTV=0 Q
..S PSBLACTV=$S($G(PSBFON)["P":0,$G(PSBFON)']"":PSBLACTV,1:1),PSBFON2=$G(PSBFON)
..S:(PSBLACTV)&($G(PSBOST)>($$FMADD^XLFDT($$NOW^XLFDT,,,$$GET^XPAR("DIV","PSB ADMIN BEFORE")))) PSBLACTV=0
.D CLEAN^PSBVT,PSJ^PSBVT(PSBX) ;Refresh data
.K PSBCOMP,PSBCOMPX,PSBINFDT,PSBINFST D INFUSING^PSBVDLU2
.D NOW^%DTC
.I ((PSBOSTS="A")!(PSBOSTS="R"))&(PSBOSP<%) S PSBOSTS="E"
.I (PSBOSTS["D")&(PSBCOMP=0) Q ; Is it DC'd and not infusing or stopped
.I PSBOSTS="E",PSBCOMP=0 Q ; Is expired and not infusing or stopped
.I PSBOSTS="D",PSBCOMP=1,($G(PSBFON)]""),PSBLACTV Q ; order is DC'ed will be picked up by following order
.I PSBOSTS="E",PSBCOMP=1,($G(PSBFON)]""),PSBLACTV Q ; order is expired will be picked up by following order
.I PSBOSTS="R",PSBFOR="R",PSBOSP<PSBWBEG Q ; order is renewed bag picked up by following order
.Q:$G(^TMP("PSB",$J,"ON IVTAB",PSBDFN,PSBONX))=1 ; The "previous order" is displayed on the VDL!
.I (PSBOSTS["E")&(PSBCOMP=0) Q ; Is it expired and not infusing
.I PSBIVT["S",PSBISYR=1 Q ; No intermittent syringes - done on PB tab
.I PSBIVT["C",PSBISYR=1 Q ; No intermittent syringes - done on PB tab
.I PSBIVT["C",PSBCHEMT="P" Q ; No Piggyback Chemos
.I PSBNGF&(PSBCOMP=1) Q ; Is it marked DO NOT GIVE!
.;
.; Non One-Times with stop date/time < now
.;
.D NOW^%DTC
.I PSBOSP<%,PSBOSTS'="R",PSBCOMP'=1 Q
.;
.; include Active, Renewed, ReInstated and On Call and Hold and Expired infusing
.; (Is it not one time)&(Is it not active or renewed or On Call or Hold)
.Q:PSBSCHT'="O"&((PSBOSTS'="A")&(PSBOSTS'="R")&(PSBOSTS'="RE")&(PSBOSTS'="O")&(PSBOSTS'="D")&(PSBOSTS'="H")&(PSBOSTS'="E"))
.;
.; Is One Time Given
.;
.I PSBSCHT="O" D Q:PSBGVN
..S (PSBGVN,X,Y)=""
..F S X=$O(^PSB(53.79,"AOIP",DFN,PSBOIT,X),-1) Q:'X D
...F S Y=$O(^PSB(53.79,"AOIP",DFN,PSBOIT,X,Y),-1) Q:'Y D
....I $P(^PSB(53.79,Y,.1),U)=PSBON,$P(^PSB(53.79,Y,0),U,9)="G" S PSBGVN=1,(X,Y)=0
.;
.; Is On-Call Given, Can it be given more than once
.;
.I PSBSCHT="OC" D Q:PSBGVN&('$$GET^XPAR("DIV","PSB ADMIN MULTIPLE ONCALL"))
..S (PSBGVN,X,Y)=""
..F S X=$O(^PSB(53.79,"AOIP",DFN,PSBOIT,X),-1) Q:'X D
...F S Y=$O(^PSB(53.79,"AOIP",DFN,PSBOIT,X,Y),-1) Q:'Y D
....I $P(^PSB(53.79,Y,.1),U)=PSBON,$P(^PSB(53.79,Y,0),U,9)="G" S PSBGVN=1,(X,Y)=0
.;
OK .S PSBSTRT=PSBOST ; Order Start Date/Time
.S PSBSTOP=PSBOSP ; Order Stop Date/Time
.;
.S PSBREC=""
.S $P(PSBREC,U,1)=DFN ; dfn
.S $P(PSBREC,U,2)=PSBONX ; Order
.S $P(PSBREC,U,3)=+PSBON ; order ien
.S $P(PSBREC,U,4)=PSBOTYP ; iv/ud/pending
.S $P(PSBREC,U,5)=PSBSCHT ; schedule type
.S $P(PSBREC,U,6)=PSBSCH ; schedule
.S Y=""
.S:PSBSM Y="SM"
.S:PSBHSM Y="HSM"
.S $P(PSBREC,U,7)=Y ; self med
.S $P(PSBREC,U,8)=PSBOITX ; drugname
.S $P(PSBREC,U,9)=PSBDOSE_" "_PSBIFR ; dosage
.S $P(PSBREC,U,10)=PSBMR ; med route
.; IV Information Column *new* - status date/time
.; (only stopped or infusing)
.;
.D:PSBCOMP
..S $P(PSBREC,U,11)=PSBINFDT K PSBINFDT
..S PSBSTUS=PSBINFST,$P(PSBREC,U,20)=PSBSTUS K PSBINFST
.S $P(PSBREC,U,14)="" ; admin date inserted below
.S $P(PSBREC,U,15)=PSBOIT ; OI Pointer
.S $P(PSBREC,U,16)=PSBNJECT ;Set injectable med route flag
.; Variable dosage entered as ####-####?
.I $P(PSBREC,U,9)?1.4N1"-"1.4N.E S $P(PSBREC,U,17)=1
.E S $P(PSBREC,U,17)=0
.S $P(PSBREC,U,18)=PSBIVT ;IV TYPE
.S $P(PSBREC,U,21)=PSBOST
.S $P(PSBREC,U,22)=PSBOSTS
.S $P(PSBREC,U,26)=PSBSTOP
.S $P(PSBREC,U,27)=$$LASTG^PSBCSUTL(DFN,PSBOIT)
.;*58 determine if override or intervn exists, send 1/0 (true/false)
.N PSBARR D GETPROVL^PSGSICH1(DFN,PSBONX,.PSBARR)
.I $O(PSBARR(""))="" D INTRDIC^PSGSICH1(DFN,PSBONX,.PSBARR,2)
.S $P(PSBREC,U,29)=$S($O(PSBARR(""))]"":1,1:0)
.; piece 30 reserved by UNIT DOSE tab for last injection
.; piece 31 reserved by IVPB tab for injection flag
.S $P(PSBREC,U,32)=$G(PSBCLORD) ;clinic name *70
.S $P(PSBREC,U,33)=$G(PSBCLIEN) ;clinic ien ptr *70
.S $P(PSBREC,U,36)=$G(PSBHAZHN) ;Hazardous to Handle *106
.S $P(PSBREC,U,37)=$G(PSBHAZDS) ;Hazardous to Dispose *106
.;
.; Gather Dispense Drugs
.D NOW^%DTC
.S (PSBDDS,PSBSOLS,PSBADDS)="0"
.F Y=0:0 S Y=$O(PSBDDA(Y)) Q:'Y D
..Q:$P(PSBDDA(Y),U,4)&($P(PSBDDA(Y),U,4)<%) ; Inactive
..S:$P(PSBDDA(Y),U,3)="" $P(PSBDDA(Y),U,3)=1
..S PSBDDS=PSBDDS_U_$P(PSBDDA(Y),U,1,3)
..S $P(PSBDDS,U,1)=PSBDDS+1
.; On-Call One Time PRN orders
.S PSBQRR=0
.I "^O^OC^P^"[(U_PSBSCHT_U) D Q
..I 'PSBDOADD S PSBTBOUT=1,^TMP("PSB",$J,"IVTAB",0)=2,^TMP("PSB",$J,"IVTAB",1)=1,^TMP("PSB",$J,"IVTAB",2)=1 Q
..D ADD^PSBVDLU1(PSBREC,PSBOTXT,PSBNOW\1,PSBDDS,PSBSOLS,PSBADDS,"IVTAB")
..S:$G(PSBFON)'="" ^TMP("PSB",$J,"ON IVTAB",PSBDFN,PSBFON)=1 ; Now do not have to place "following order" on VDL!
.;
.; IV's - don't worry about admin times if blank
.I PSBONX["V",PSBIVT'="P",PSBADST="" D Q
..I 'PSBDOADD S PSBTBOUT=1,^TMP("PSB",$J,"IVTAB",0)=2,^TMP("PSB",$J,"IVTAB",1)=1,^TMP("PSB",$J,"IVTAB",2)=1 Q
..D ADD^PSBVDLU1(PSBREC,PSBOTXT,PSBNOW\1_".",PSBDDS,PSBSOLS,PSBADDS,"IVTAB")
..S:$G(PSBFON)'="" ^TMP("PSB",$J,"ON IVTAB",PSBDFN,PSBFON)=1 ; Now do not have to place "following order" on VDL!
.;
.; Now we deal with only continuous
.; process admintimes
.S PSBFREQ=$$GETFREQ^PSBVDLU1(DFN,PSBONX)
.S PSBADMIN=PSBADST
.; process admin times against beginning and ending date
.; build all orders for both days.
.F PSBY=1:1 Q:$P(PSBADMIN,"-",PSBY)="" D
..; apply this time to the beginning window date
..S PSB=+(PSBWBEG\1_"."_$P(PSBADMIN,"-",PSBY))
..D:(PSB'<PSBWBEG)&(PSB'>PSBWEND) ; Make sure it is in the window
...D:(PSB'<PSBSTRT)&(PSB<PSBSTOP) ; Make sure this time is active
....D:$$OKAY^PSBVDLU1(PSBSTRT,$P(PSB,"."),PSBSCH,PSBON,PSBOITX,PSBFREQ) ; Okay on this date?
.....I 'PSBDOADD S PSBTBOUT=1,^TMP("PSB",$J,"IVTAB",0)=2,^TMP("PSB",$J,"IVTAB",1)=1,^TMP("PSB",$J,"IVTAB",2)=1 Q
.....D ADD^PSBVDLU1(PSBREC,PSBOTXT,PSB,PSBDDS,PSBSOLS,PSBADDS,"IVTAB")
.....S:$G(PSBFON)'="" ^TMP("PSB",$J,"ON IVTAB",PSBDFN,PSBFON)=1 ; Now do not have to place "following order" on VDL!
..;
..Q:(PSBWBEG\1)=(PSBWEND\1) ; Window only has one day rare but possible
..;
..; apply this time to the ending window date
..S PSB=+(PSBWEND\1_"."_$P(PSBADMIN,"-",PSBY))
..D:(PSB'<PSBWBEG)&(PSB'>PSBWEND) ; Make sure it is in the window
...D:(PSB'<PSBSTRT)&(PSB<PSBSTOP) ; Make sure this time is active
....D:$$OKAY^PSBVDLU1(PSBSTRT,$P(PSB,"."),PSBSCH,PSBON,PSBOITX,PSBFREQ) ; Okay on this date?
.....I 'PSBDOADD S PSBTBOUT=1,^TMP("PSB",$J,"IVTAB",0)=2,^TMP("PSB",$J,"IVTAB",1)=1,^TMP("PSB",$J,"IVTAB",2)=1 Q
.....D ADD^PSBVDLU1(PSBREC,PSBOTXT,PSB,PSBDDS,PSBSOLS,PSBADDS,"IVTAB")
.....S:$G(PSBFON)'="" ^TMP("PSB",$J,"ON IVTAB",PSBDFN,PSBFON)=1 ; Now do not have to place "following order" on VDL!
K ^TMP("PSB",$J,"ON IVTAB")
;
;add initials of verifying pharmacist/verifying nurse
D:PSBDOADD VNURSE^PSBVDLU1("IVTAB")
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSBVDLIV 9609 printed Dec 13, 2024@01:41:16 Page 2
PSBVDLIV ;BIRMINGHAM/EFC-BCMA IV VIRTUAL DUE LIST ;03/06/16 3:06pm
+1 ;;3.0;BAR CODE MED ADMIN;**6,38,32,58,70,83,106**;Mar 2004;Build 43
+2 ;Per VHA Directive 2004-038 (or future revisions regarding same), this routine should not be modified.
+3 ;
+4 ; Reference/IA
+5 ; EN^PSJBCMA/2828
+6 ; EN^PSJBCMA1/2829
+7 ; GETPROVL^PSGSICH1/5653
+8 ; INTRDIC^PSGSICH1/5654
+9 ;
+10 ;*58 - add 29th piece to Results for Override/Intervention flag 1/0
+11 ;*70 - add 32nd piece to Results for Clinic Order name
+12 ; - add 33rd piece to Results for Clinic ien ptr to file #44
+13 ;*83 - Clinic Orders should show up on VDL's when start order date
+14 ; is Today now ignores the time portion of that field.
+15 ;*106- add Hazardous to Handle & Dispose flags 36 & 37
+16 ;
EN(DFN,PSBDT) ; Default Order List Return for Today
+1 ;
+2 ; RPC: PSB GETORDERLIST
+3 ;
+4 ; Description:
+5 ; Returns the current IV order set for today to display on the
+6 ; client VDL
+7 ;
+8 ;*70
NEW PSBDATA,PSBTBOUT,PSBDOADD,PSBDT2,X,PSHIST
+9 SET PSBTBOUT=0
SET PSBDOADD=0
+10 if PSBTAB="IVTAB"
SET PSBDOADD=1
+11 ;
+12 ; Passing PSBDT as 3rd parameter turns off the V.1.0 One-Time lookback
+13 KILL ^TMP("PSJ",$JOB),^TMP("PSB",$JOB,"ON IVTAB")
+14 ;*70 default hist days back
SET PSBHIST=$SELECT(PSBCLINORD:-7,1:-3)
+15 ;*70
SET X1=PSBDT
SET X2=PSBHIST
DO C^%DTC
SET PSBDT2=X
+16 DO EN^PSJBCMA(DFN,PSBDT2,PSBDT)
+17 ;Filter in/out Clinic Orders ;*70
+18 if PSBCLINORD
DO INCLUDCO^PSBVDLU1
+19 if 'PSBCLINORD
DO REMOVECO^PSBVDLU1
+20 ;
+21 ; No orders
IF $GET(^TMP("PSJ",$JOB,1,0))=-1
QUIT
+22 ;
+23 FOR PSBX=0:0
SET PSBX=$ORDER(^TMP("PSJ",$JOB,PSBX))
if ('PSBX)!(PSBTBOUT)
QUIT
Begin DoDot:1
+24 NEW PSBRTNOW
SET PSBRTNOW=$$NOW^XLFDT()
+25 DO CLEAN^PSBVT
DO PSJ^PSBVT(PSBX)
+26 ;
+27 ; << Standard checks for ALL orders >>
+28 ;
+29 ; IVs only
if PSBONX'["V"
QUIT
+30 ; No piggybacks
if PSBIVT["P"
QUIT
+31 ; No Pending Orders
if PSBONX["P"
QUIT
+32 ;*70 don't check this for CO's
if ('PSBCLINORD)&(PSBOST>($$FMADD^XLFDT($$NOW^XLFDT,,,$$GET^XPAR("DIV","PSB ADMIN BEFORE"))))
QUIT
+33 ;CO Order future start check now based on the date only Not time *83
+34 if ($GET(PSBCLORD)]"")&($PIECE(PSBOST,".")>$PIECE(PSBRTNOW,"."))
QUIT
+35 ;
+36 ; Need to see if "last order" in chain is active/not pending.
+37 ;
SET PSBFON1=PSBFON
SET PSBLOOP=0
IF $GET(PSBFON)]""
SET PSBLACTV=$SELECT($GET(PSBFON)["P":0,1:1)
SET PSBFON2=$GET(PSBFON)
IF 'PSBLACTV
FOR
Begin DoDot:2
+38 IF $GET(PSBFON)["P"
KILL ^TMP("PSJ1",$JOB)
DO EN^PSJBCMA1(DFN,PSBFON2,1)
IF ^TMP("PSJ1",$JOB,0)=-1
SET PSBFON=""
+39 if $GET(PSBFON)[""
DO CLEAN^PSBVT
DO PSJ1^PSBVT(DFN,PSBFON2)
+40 IF PSBFON=PSBFON2
SET PSBLOOP=1
SET PSBLACTV=0
QUIT
+41 SET PSBLACTV=$SELECT($GET(PSBFON)["P":0,$GET(PSBFON)']"":PSBLACTV,1:1)
SET PSBFON2=$GET(PSBFON)
+42 if (PSBLACTV)&($GET(PSBOST)>($$FMADD^XLFDT($$NOW^XLFDT,,,$$GET^XPAR("DIV","PSB ADMIN BEFORE"))))
SET PSBLACTV=0
End DoDot:2
if ($GET(PSBFON)="")!($GET(PSBFON1)=$GET(PSBFON2))!(PSBLOOP)!(PSBLACTV)
QUIT
+43 ;Refresh data
DO CLEAN^PSBVT
DO PSJ^PSBVT(PSBX)
+44 KILL PSBCOMP,PSBCOMPX,PSBINFDT,PSBINFST
DO INFUSING^PSBVDLU2
+45 DO NOW^%DTC
+46 IF ((PSBOSTS="A")!(PSBOSTS="R"))&(PSBOSP<%)
SET PSBOSTS="E"
+47 ; Is it DC'd and not infusing or stopped
IF (PSBOSTS["D")&(PSBCOMP=0)
QUIT
+48 ; Is expired and not infusing or stopped
IF PSBOSTS="E"
IF PSBCOMP=0
QUIT
+49 ; order is DC'ed will be picked up by following order
IF PSBOSTS="D"
IF PSBCOMP=1
IF ($GET(PSBFON)]"")
IF PSBLACTV
QUIT
+50 ; order is expired will be picked up by following order
IF PSBOSTS="E"
IF PSBCOMP=1
IF ($GET(PSBFON)]"")
IF PSBLACTV
QUIT
+51 ; order is renewed bag picked up by following order
IF PSBOSTS="R"
IF PSBFOR="R"
IF PSBOSP<PSBWBEG
QUIT
+52 ; The "previous order" is displayed on the VDL!
if $GET(^TMP("PSB",$JOB,"ON IVTAB",PSBDFN,PSBONX))=1
QUIT
+53 ; Is it expired and not infusing
IF (PSBOSTS["E")&(PSBCOMP=0)
QUIT
+54 ; No intermittent syringes - done on PB tab
IF PSBIVT["S"
IF PSBISYR=1
QUIT
+55 ; No intermittent syringes - done on PB tab
IF PSBIVT["C"
IF PSBISYR=1
QUIT
+56 ; No Piggyback Chemos
IF PSBIVT["C"
IF PSBCHEMT="P"
QUIT
+57 ; Is it marked DO NOT GIVE!
IF PSBNGF&(PSBCOMP=1)
QUIT
+58 ;
+59 ; Non One-Times with stop date/time < now
+60 ;
+61 DO NOW^%DTC
+62 IF PSBOSP<%
IF PSBOSTS'="R"
IF PSBCOMP'=1
QUIT
+63 ;
+64 ; include Active, Renewed, ReInstated and On Call and Hold and Expired infusing
+65 ; (Is it not one time)&(Is it not active or renewed or On Call or Hold)
+66 if PSBSCHT'="O"&((PSBOSTS'="A")&(PSBOSTS'="R")&(PSBOSTS'="RE")&(PSBOSTS'="O")&(PSBOSTS'="D")&(PSBOSTS'="H")&(PSBOSTS'="E"))
QUIT
+67 ;
+68 ; Is One Time Given
+69 ;
+70 IF PSBSCHT="O"
Begin DoDot:2
+71 SET (PSBGVN,X,Y)=""
+72 FOR
SET X=$ORDER(^PSB(53.79,"AOIP",DFN,PSBOIT,X),-1)
if 'X
QUIT
Begin DoDot:3
+73 FOR
SET Y=$ORDER(^PSB(53.79,"AOIP",DFN,PSBOIT,X,Y),-1)
if 'Y
QUIT
Begin DoDot:4
+74 IF $PIECE(^PSB(53.79,Y,.1),U)=PSBON
IF $PIECE(^PSB(53.79,Y,0),U,9)="G"
SET PSBGVN=1
SET (X,Y)=0
End DoDot:4
End DoDot:3
End DoDot:2
if PSBGVN
QUIT
+75 ;
+76 ; Is On-Call Given, Can it be given more than once
+77 ;
+78 IF PSBSCHT="OC"
Begin DoDot:2
+79 SET (PSBGVN,X,Y)=""
+80 FOR
SET X=$ORDER(^PSB(53.79,"AOIP",DFN,PSBOIT,X),-1)
if 'X
QUIT
Begin DoDot:3
+81 FOR
SET Y=$ORDER(^PSB(53.79,"AOIP",DFN,PSBOIT,X,Y),-1)
if 'Y
QUIT
Begin DoDot:4
+82 IF $PIECE(^PSB(53.79,Y,.1),U)=PSBON
IF $PIECE(^PSB(53.79,Y,0),U,9)="G"
SET PSBGVN=1
SET (X,Y)=0
End DoDot:4
End DoDot:3
End DoDot:2
if PSBGVN&('$$GET^XPAR("DIV","PSB ADMIN MULTIPLE ONCALL"))
QUIT
+83 ;
OK ; Order Start Date/Time
SET PSBSTRT=PSBOST
+1 ; Order Stop Date/Time
SET PSBSTOP=PSBOSP
+2 ;
+3 SET PSBREC=""
+4 ; dfn
SET $PIECE(PSBREC,U,1)=DFN
+5 ; Order
SET $PIECE(PSBREC,U,2)=PSBONX
+6 ; order ien
SET $PIECE(PSBREC,U,3)=+PSBON
+7 ; iv/ud/pending
SET $PIECE(PSBREC,U,4)=PSBOTYP
+8 ; schedule type
SET $PIECE(PSBREC,U,5)=PSBSCHT
+9 ; schedule
SET $PIECE(PSBREC,U,6)=PSBSCH
+10 SET Y=""
+11 if PSBSM
SET Y="SM"
+12 if PSBHSM
SET Y="HSM"
+13 ; self med
SET $PIECE(PSBREC,U,7)=Y
+14 ; drugname
SET $PIECE(PSBREC,U,8)=PSBOITX
+15 ; dosage
SET $PIECE(PSBREC,U,9)=PSBDOSE_" "_PSBIFR
+16 ; med route
SET $PIECE(PSBREC,U,10)=PSBMR
+17 ; IV Information Column *new* - status date/time
+18 ; (only stopped or infusing)
+19 ;
+20 if PSBCOMP
Begin DoDot:2
+21 SET $PIECE(PSBREC,U,11)=PSBINFDT
KILL PSBINFDT
+22 SET PSBSTUS=PSBINFST
SET $PIECE(PSBREC,U,20)=PSBSTUS
KILL PSBINFST
End DoDot:2
+23 ; admin date inserted below
SET $PIECE(PSBREC,U,14)=""
+24 ; OI Pointer
SET $PIECE(PSBREC,U,15)=PSBOIT
+25 ;Set injectable med route flag
SET $PIECE(PSBREC,U,16)=PSBNJECT
+26 ; Variable dosage entered as ####-####?
+27 IF $PIECE(PSBREC,U,9)?1.4N1"-"1.4N.E
SET $PIECE(PSBREC,U,17)=1
+28 IF '$TEST
SET $PIECE(PSBREC,U,17)=0
+29 ;IV TYPE
SET $PIECE(PSBREC,U,18)=PSBIVT
+30 SET $PIECE(PSBREC,U,21)=PSBOST
+31 SET $PIECE(PSBREC,U,22)=PSBOSTS
+32 SET $PIECE(PSBREC,U,26)=PSBSTOP
+33 SET $PIECE(PSBREC,U,27)=$$LASTG^PSBCSUTL(DFN,PSBOIT)
+34 ;*58 determine if override or intervn exists, send 1/0 (true/false)
+35 NEW PSBARR
DO GETPROVL^PSGSICH1(DFN,PSBONX,.PSBARR)
+36 IF $ORDER(PSBARR(""))=""
DO INTRDIC^PSGSICH1(DFN,PSBONX,.PSBARR,2)
+37 SET $PIECE(PSBREC,U,29)=$SELECT($ORDER(PSBARR(""))]"":1,1:0)
+38 ; piece 30 reserved by UNIT DOSE tab for last injection
+39 ; piece 31 reserved by IVPB tab for injection flag
+40 ;clinic name *70
SET $PIECE(PSBREC,U,32)=$GET(PSBCLORD)
+41 ;clinic ien ptr *70
SET $PIECE(PSBREC,U,33)=$GET(PSBCLIEN)
+42 ;Hazardous to Handle *106
SET $PIECE(PSBREC,U,36)=$GET(PSBHAZHN)
+43 ;Hazardous to Dispose *106
SET $PIECE(PSBREC,U,37)=$GET(PSBHAZDS)
+44 ;
+45 ; Gather Dispense Drugs
+46 DO NOW^%DTC
+47 SET (PSBDDS,PSBSOLS,PSBADDS)="0"
+48 FOR Y=0:0
SET Y=$ORDER(PSBDDA(Y))
if 'Y
QUIT
Begin DoDot:2
+49 ; Inactive
if $PIECE(PSBDDA(Y),U,4)&($PIECE(PSBDDA(Y),U,4)<%)
QUIT
+50 if $PIECE(PSBDDA(Y),U,3)=""
SET $PIECE(PSBDDA(Y),U,3)=1
+51 SET PSBDDS=PSBDDS_U_$PIECE(PSBDDA(Y),U,1,3)
+52 SET $PIECE(PSBDDS,U,1)=PSBDDS+1
End DoDot:2
+53 ; On-Call One Time PRN orders
+54 SET PSBQRR=0
+55 IF "^O^OC^P^"[(U_PSBSCHT_U)
Begin DoDot:2
+56 IF 'PSBDOADD
SET PSBTBOUT=1
SET ^TMP("PSB",$JOB,"IVTAB",0)=2
SET ^TMP("PSB",$JOB,"IVTAB",1)=1
SET ^TMP("PSB",$JOB,"IVTAB",2)=1
QUIT
+57 DO ADD^PSBVDLU1(PSBREC,PSBOTXT,PSBNOW\1,PSBDDS,PSBSOLS,PSBADDS,"IVTAB")
+58 ; Now do not have to place "following order" on VDL!
if $GET(PSBFON)'=""
SET ^TMP("PSB",$JOB,"ON IVTAB",PSBDFN,PSBFON)=1
End DoDot:2
QUIT
+59 ;
+60 ; IV's - don't worry about admin times if blank
+61 IF PSBONX["V"
IF PSBIVT'="P"
IF PSBADST=""
Begin DoDot:2
+62 IF 'PSBDOADD
SET PSBTBOUT=1
SET ^TMP("PSB",$JOB,"IVTAB",0)=2
SET ^TMP("PSB",$JOB,"IVTAB",1)=1
SET ^TMP("PSB",$JOB,"IVTAB",2)=1
QUIT
+63 DO ADD^PSBVDLU1(PSBREC,PSBOTXT,PSBNOW\1_".",PSBDDS,PSBSOLS,PSBADDS,"IVTAB")
+64 ; Now do not have to place "following order" on VDL!
if $GET(PSBFON)'=""
SET ^TMP("PSB",$JOB,"ON IVTAB",PSBDFN,PSBFON)=1
End DoDot:2
QUIT
+65 ;
+66 ; Now we deal with only continuous
+67 ; process admintimes
+68 SET PSBFREQ=$$GETFREQ^PSBVDLU1(DFN,PSBONX)
+69 SET PSBADMIN=PSBADST
+70 ; process admin times against beginning and ending date
+71 ; build all orders for both days.
+72 FOR PSBY=1:1
if $PIECE(PSBADMIN,"-",PSBY)=""
QUIT
Begin DoDot:2
+73 ; apply this time to the beginning window date
+74 SET PSB=+(PSBWBEG\1_"."_$PIECE(PSBADMIN,"-",PSBY))
+75 ; Make sure it is in the window
if (PSB'<PSBWBEG)&(PSB'>PSBWEND)
Begin DoDot:3
+76 ; Make sure this time is active
if (PSB'<PSBSTRT)&(PSB<PSBSTOP)
Begin DoDot:4
+77 ; Okay on this date?
if $$OKAY^PSBVDLU1(PSBSTRT,$PIECE(PSB,"."),PSBSCH,PSBON,PSBOITX,PSBFREQ)
Begin DoDot:5
+78 IF 'PSBDOADD
SET PSBTBOUT=1
SET ^TMP("PSB",$JOB,"IVTAB",0)=2
SET ^TMP("PSB",$JOB,"IVTAB",1)=1
SET ^TMP("PSB",$JOB,"IVTAB",2)=1
QUIT
+79 DO ADD^PSBVDLU1(PSBREC,PSBOTXT,PSB,PSBDDS,PSBSOLS,PSBADDS,"IVTAB")
+80 ; Now do not have to place "following order" on VDL!
if $GET(PSBFON)'=""
SET ^TMP("PSB",$JOB,"ON IVTAB",PSBDFN,PSBFON)=1
End DoDot:5
End DoDot:4
End DoDot:3
+81 ;
+82 ; Window only has one day rare but possible
if (PSBWBEG\1)=(PSBWEND\1)
QUIT
+83 ;
+84 ; apply this time to the ending window date
+85 SET PSB=+(PSBWEND\1_"."_$PIECE(PSBADMIN,"-",PSBY))
+86 ; Make sure it is in the window
if (PSB'<PSBWBEG)&(PSB'>PSBWEND)
Begin DoDot:3
+87 ; Make sure this time is active
if (PSB'<PSBSTRT)&(PSB<PSBSTOP)
Begin DoDot:4
+88 ; Okay on this date?
if $$OKAY^PSBVDLU1(PSBSTRT,$PIECE(PSB,"."),PSBSCH,PSBON,PSBOITX,PSBFREQ)
Begin DoDot:5
+89 IF 'PSBDOADD
SET PSBTBOUT=1
SET ^TMP("PSB",$JOB,"IVTAB",0)=2
SET ^TMP("PSB",$JOB,"IVTAB",1)=1
SET ^TMP("PSB",$JOB,"IVTAB",2)=1
QUIT
+90 DO ADD^PSBVDLU1(PSBREC,PSBOTXT,PSB,PSBDDS,PSBSOLS,PSBADDS,"IVTAB")
+91 ; Now do not have to place "following order" on VDL!
if $GET(PSBFON)'=""
SET ^TMP("PSB",$JOB,"ON IVTAB",PSBDFN,PSBFON)=1
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+92 KILL ^TMP("PSB",$JOB,"ON IVTAB")
+93 ;
+94 ;add initials of verifying pharmacist/verifying nurse
+95 if PSBDOADD
DO VNURSE^PSBVDLU1("IVTAB")
+96 QUIT
+97 ;
