PSBVDLIV ;BIRMINGHAM/EFC-BCMA IV VIRTUAL DUE LIST ;Mar 2004
;;3.0;BAR CODE MED ADMIN;**6,38,32**;Mar 2004;Build 32
;Per VHA Directive 2004-038 (or future revisions regarding same), this routine should not be modified.
;
; Reference/IA
; EN^PSJBCMA/2828
; EN^PSJBCMA1/2829
;
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
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 X1=PSBDT,X2=-3 D C^%DTC S PSBDT2=X D EN^PSJBCMA(DFN,PSBDT2,PSBDT)
;
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
.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:PSBOST>($$FMADD^XLFDT($$NOW^XLFDT,,,$$GET^XPAR("DIV","PSB ADMIN BEFORE")))
.; 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)
.;
.; 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
;
PSBVDLIV ;BIRMINGHAM/EFC-BCMA IV VIRTUAL DUE LIST ;Mar 2004
+1 ;;3.0;BAR CODE MED ADMIN;**6,38,32**;Mar 2004;Build 32
+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 ;
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 NEW PSBDATA,PSBTBOUT,PSBDOADD
+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")
SET X1=PSBDT
SET X2=-3
DO C^%DTC
SET PSBDT2=X
DO EN^PSJBCMA(DFN,PSBDT2,PSBDT)
+14 ;
+15 ; No orders
IF $GET(^TMP("PSJ",$JOB,1,0))=-1
QUIT
+16 ;
+17 FOR PSBX=0:0
SET PSBX=$ORDER(^TMP("PSJ",$JOB,PSBX))
IF ('PSBX)!(PSBTBOUT)
QUIT
Begin DoDot:1
+18 DO CLEAN^PSBVT
DO PSJ^PSBVT(PSBX)
+19 ;
+20 ; << Standard checks for ALL orders >>
+21 ;
+22 ; IVs only
IF PSBONX'["V"
QUIT
+23 ; No piggybacks
IF PSBIVT["P"
QUIT
+24 ; No Pending Orders
IF PSBONX["P"
QUIT
+25 IF PSBOST>($$FMADD^XLFDT($$NOW^XLFDT,,,$$GET^XPAR("DIV","PSB ADMIN BEFORE")))
QUIT
+26 ; Need to see if "last order" in chain is active/not pending.
+27 ;
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
+28 IF $GET(PSBFON)["P"
KILL ^TMP("PSJ1",$JOB)
DO EN^PSJBCMA1(DFN,PSBFON2,1)
IF ^TMP("PSJ1",$JOB,0)=-1
SET PSBFON=""
+29 IF $GET(PSBFON)[""
DO CLEAN^PSBVT
DO PSJ1^PSBVT(DFN,PSBFON2)
+30 IF PSBFON=PSBFON2
SET PSBLOOP=1
SET PSBLACTV=0
QUIT
+31 SET PSBLACTV=$SELECT($GET(PSBFON)["P":0,$GET(PSBFON)']"":PSBLACTV,1:1)
SET PSBFON2=$GET(PSBFON)
+32 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
+33 ;Refresh data
DO CLEAN^PSBVT
DO PSJ^PSBVT(PSBX)
+34 KILL PSBCOMP,PSBCOMPX,PSBINFDT,PSBINFST
DO INFUSING^PSBVDLU2
+35 DO NOW^%DTC
+36 IF ((PSBOSTS="A")!(PSBOSTS="R"))&(PSBOSP<%)
SET PSBOSTS="E"
+37 ; Is it DC'd and not infusing or stopped
IF (PSBOSTS["D")&(PSBCOMP=0)
QUIT
+38 ; Is expired and not infusing or stopped
IF PSBOSTS="E"
IF PSBCOMP=0
QUIT
+39 ; order is DC'ed will be picked up by following order
IF PSBOSTS="D"
IF PSBCOMP=1
IF ($GET(PSBFON)]"")
IF PSBLACTV
QUIT
+40 ; order is expired will be picked up by following order
IF PSBOSTS="E"
IF PSBCOMP=1
IF ($GET(PSBFON)]"")
IF PSBLACTV
QUIT
+41 ; order is renewed bag picked up by following order
IF PSBOSTS="R"
IF PSBFOR="R"
IF PSBOSP<PSBWBEG
QUIT
+42 ; The "previous order" is displayed on the VDL!
IF $GET(^TMP("PSB",$JOB,"ON IVTAB",PSBDFN,PSBONX))=1
QUIT
+43 ; Is it expired and not infusing
IF (PSBOSTS["E")&(PSBCOMP=0)
QUIT
+44 ; No intermittent syringes - done on PB tab
IF PSBIVT["S"
IF PSBISYR=1
QUIT
+45 ; No intermittent syringes - done on PB tab
IF PSBIVT["C"
IF PSBISYR=1
QUIT
+46 ; No Piggyback Chemos
IF PSBIVT["C"
IF PSBCHEMT="P"
QUIT
+47 ; Is it marked DO NOT GIVE!
IF PSBNGF&(PSBCOMP=1)
QUIT
+48 ;
+49 ; Non One-Times with stop date/time < now
+50 ;
+51 DO NOW^%DTC
+52 IF PSBOSP<%
IF PSBOSTS'="R"
IF PSBCOMP'=1
QUIT
+53 ;
+54 ; include Active, Renewed, ReInstated and On Call and Hold and Expired infusing
+55 ; (Is it not one time)&(Is it not active or renewed or On Call or Hold)
+56 IF PSBSCHT'="O"&((PSBOSTS'="A")&(PSBOSTS'="R")&(PSBOSTS'="RE")&(PSBOSTS'="O")&(PSBOSTS'="D")&(PSBOSTS'="H")&(PSBOSTS'="E"))
QUIT
+57 ;
+58 ; Is One Time Given
+59 ;
+60 IF PSBSCHT="O"
Begin DoDot:2
+61 SET (PSBGVN,X,Y)=""
+62 FOR
SET X=$ORDER(^PSB(53.79,"AOIP",DFN,PSBOIT,X),-1)
IF 'X
QUIT
Begin DoDot:3
+63 FOR
SET Y=$ORDER(^PSB(53.79,"AOIP",DFN,PSBOIT,X,Y),-1)
IF 'Y
QUIT
Begin DoDot:4
+64 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
+65 ;
+66 ; Is On-Call Given, Can it be given more than once
+67 ;
+68 IF PSBSCHT="OC"
Begin DoDot:2
+69 SET (PSBGVN,X,Y)=""
+70 FOR
SET X=$ORDER(^PSB(53.79,"AOIP",DFN,PSBOIT,X),-1)
IF 'X
QUIT
Begin DoDot:3
+71 FOR
SET Y=$ORDER(^PSB(53.79,"AOIP",DFN,PSBOIT,X,Y),-1)
IF 'Y
QUIT
Begin DoDot:4
+72 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
+73 ;
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 ;
+35 ; Gather Dispense Drugs
+36 DO NOW^%DTC
+37 SET (PSBDDS,PSBSOLS,PSBADDS)="0"
+38 FOR Y=0:0
SET Y=$ORDER(PSBDDA(Y))
IF 'Y
QUIT
Begin DoDot:2
+39 ; Inactive
IF $PIECE(PSBDDA(Y),U,4)&($PIECE(PSBDDA(Y),U,4)<%)
QUIT
+40 IF $PIECE(PSBDDA(Y),U,3)=""
SET $PIECE(PSBDDA(Y),U,3)=1
+41 SET PSBDDS=PSBDDS_U_$PIECE(PSBDDA(Y),U,1,3)
+42 SET $PIECE(PSBDDS,U,1)=PSBDDS+1
End DoDot:2
+43 ; On-Call One Time PRN orders
+44 SET PSBQRR=0
+45 IF "^O^OC^P^"[(U_PSBSCHT_U)
Begin DoDot:2
+46 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
+47 DO ADD^PSBVDLU1(PSBREC,PSBOTXT,PSBNOW\1,PSBDDS,PSBSOLS,PSBADDS,"IVTAB")
+48 ; 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
+49 ;
+50 ; IV's - don't worry about admin times if blank
+51 IF PSBONX["V"
IF PSBIVT'="P"
IF PSBADST=""
Begin DoDot:2
+52 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
+53 DO ADD^PSBVDLU1(PSBREC,PSBOTXT,PSBNOW\1_".",PSBDDS,PSBSOLS,PSBADDS,"IVTAB")
+54 ; 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
+55 ;
+56 ; Now we deal with only continuous
+57 ; process admintimes
+58 SET PSBFREQ=$$GETFREQ^PSBVDLU1(DFN,PSBONX)
+59 SET PSBADMIN=PSBADST
+60 ; process admin times against beginning and ending date
+61 ; build all orders for both days.
+62 FOR PSBY=1:1
IF $PIECE(PSBADMIN,"-",PSBY)=""
QUIT
Begin DoDot:2
+63 ; apply this time to the beginning window date
+64 SET PSB=+(PSBWBEG\1_"."_$PIECE(PSBADMIN,"-",PSBY))
+65 ; Make sure it is in the window
IF (PSB'<PSBWBEG)&(PSB'>PSBWEND)
Begin DoDot:3
+66 ; Make sure this time is active
IF (PSB'<PSBSTRT)&(PSB<PSBSTOP)
Begin DoDot:4
+67 ; Okay on this date?
IF $$OKAY^PSBVDLU1(PSBSTRT,$PIECE(PSB,"."),PSBSCH,PSBON,PSBOITX,PSBFREQ)
Begin DoDot:5
+68 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
+69 DO ADD^PSBVDLU1(PSBREC,PSBOTXT,PSB,PSBDDS,PSBSOLS,PSBADDS,"IVTAB")
+70 ; 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
+71 ;
+72 ; Window only has one day rare but possible
IF (PSBWBEG\1)=(PSBWEND\1)
QUIT
+73 ;
+74 ; apply this time to the ending window date
+75 SET PSB=+(PSBWEND\1_"."_$PIECE(PSBADMIN,"-",PSBY))
+76 ; Make sure it is in the window
IF (PSB'<PSBWBEG)&(PSB'>PSBWEND)
Begin DoDot:3
+77 ; Make sure this time is active
IF (PSB'<PSBSTRT)&(PSB<PSBSTOP)
Begin DoDot:4
+78 ; Okay on this date?
IF $$OKAY^PSBVDLU1(PSBSTRT,$PIECE(PSB,"."),PSBSCH,PSBON,PSBOITX,PSBFREQ)
Begin DoDot:5
+79 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
+80 DO ADD^PSBVDLU1(PSBREC,PSBOTXT,PSB,PSBDDS,PSBSOLS,PSBADDS,"IVTAB")
+81 ; 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
+82 KILL ^TMP("PSB",$JOB,"ON IVTAB")
+83 ;
+84 ;add initials of verifying pharmacist/verifying nurse
+85 IF PSBDOADD
DO VNURSE^PSBVDLU1("IVTAB")
+86 QUIT
+87 ;
