- 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 ;
