PSBVDLUD ;BIRMINGHAM/EFC-BCMA UNIT DOSE VIRTUAL DUE LIST FUNCTIONS ;03/06/16 3:06pm
;;3.0;BAR CODE MED ADMIN;**11,13,38,32,58,68,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
; $$GET^XPAR/2263
; GETPROVL^PSGSICH1/5653
; INTRDIC^PSGSICH1/5654
;
;*58 - add 29th piece to Results for Override/Intervention flag 1/0
;*68 - add 30th piece to Results for Last Injection Site
;*70 - add 32nd piece to Results for Clinic Order name for CO's
; - add 33rd piece to Results for Clinic ien ptr to file #44
;*83 - add 34th & 35th piece to Results via ADD^PSBVDLU1
; add call to new routine PSBVDLRM for placing MRR meds on VDL
; - 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) ;
;
; Description:
; Returns the current unit dose order set for today to display
; on the client VDL
;
N PSBDATA,PSBTBOUT
N PSBONVDL ;new here instead of kill in PA rtn *83
N ADM,MISSED,IEN,STUS
S PSBTBOUT=0
;
;This routine now re-uses the ^TMP("PSJ",$J global built in PSBVDLTB
;
G:$G(^TMP("PSJ",$J,1,0))=-1 1
F PSBX=0:0 S PSBX=$O(^TMP("PSJ",$J,PSBX)) Q:('PSBX)!(PSBTBOUT) D
.N PSBRTNOW S PSBRTNOW=$$NOW^XLFDT()
.S:(PSBTAB'="UDTAB")&($G(^TMP("PSB",$J,"UDTAB",2))>0) PSBTBOUT=1
.D CLEAN^PSBVT,PSJ^PSBVT(PSBX)
.;
.; << Standard checks for ALL orders >>
.;
.Q:PSBONX["V" ;No IVs on UD tab
.Q:PSBONX["P" ;No Pending Orders
.Q:PSBOST>PSBWADM ;Order Start Date/Time > admin window
.;CO Order future start check now based on the date only Not time *83
.Q:($G(PSBCLORD)]"")&($P(PSBOST,".")>$P(PSBRTNOW,"."))
.Q:PSBOSP<PSBWBEG ;For Non one-times Order Stop Date/Time < vdl window
.Q:PSBOSTS["D" ;Is it DC'd
.Q:PSBNGF ;Is it marked DO NOT GIVE!
.Q:PSBIVPSH ;Is it IV push
.;
.; Non One-Times with stop date/time < now
.;
.D NOW^%DTC
.Q:PSBOSP<%
.;
.; include Active, Renewed, ReInstated and On Call
.; (Is it not one time)&(Is it not active or renewed or On Call)
.I PSBSCHT'="O",PSBOSTS'="A",PSBOSTS'="H",PSBOSTS'="R",PSBOSTS'="RE",PSBOSTS'="O" Q
.;
.; 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)=PSBONX,$P(^PSB(53.79,Y,0),U,9)="G" S PSBGVN=1,(X,Y)=0
.;
.; How long does One Time remain on VDL ??
.S PSBRMN=1
.I PSBSCHT="O",PSBOSP'=PSBOST&(%>PSBOSP) S PSBRMN=0
.Q:'PSBRMN
.; 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)=PSBONX,$P(^PSB(53.79,Y,0),U,9)="G" S PSBGVN=1,(X,Y)=0
.;
.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 $P(PSBREC,U,7)=$S(PSBHSM:"HSM",PSBSM:"SM",1:"") ; 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
.; Last Given from the AOIP X-Ref - not given status not excepted
.S (PSBCNT,PSBFLAG)=0,(YZ,PSBSTUS,PSBADMER)="" K PSBHSTA,PSBHSTAX
.F XZ=1:1:20 S YZ=$O(^PSB(53.79,"AOIP",DFN,PSBOIT,YZ),-1),(PSBCNT,PSBFLAG)=0 Q:YZ="" D
..S:YZ>0 $P(PSBREC,U,11)=YZ
..S X="" F S X=$O(^PSB(53.79,"AOIP",DFN,PSBOIT,YZ,X),-1) Q:X="" D
...K PSBLCK L +^PSB(53.79,X):1 I L -^PSB(53.79,X) S PSBLCK=1
...S PSBSTUS=$P(^PSB(53.79,X,0),U,9)
...I $G(PSBSTUS)="" S:'$G(PSBLCK) PSBSTUS="X" I $G(PSBLCK) S PSBADMER=1 D
....K PSBPARM3,PSBPARM5,PSBPARM6,PSBPARM7
....S PSBPARM6=X,Y=$P(^PSB(53.79,X,.1),U,3) D DD^%DT S PSBPARM3=Y,Y=$P(^PSB(53.79,X,0),U,6) D DD^%DT S PSBPARM5=Y
....S PSBPARM7=$P(^PSB(53.79,X,0),U,7) S PSBPARM7="( # "_PSBPARM7_" ) "_$$GET1^DIQ(200,PSBPARM7_",",.01)
....K PSBXTMP S PSBXTMP=PSBONX
....D CLEAN^PSBVT,PSJ1^PSBVT(DFN,$$GET1^DIQ(53.79,PSBPARM6_",",.11))
....D ERROR^PSBMLU(PSBONX,PSBOITX,DFN,PSBPARM3_" admin's ACTION STATUS is ""UNKNOWN"".",PSBSCH,PSBPARM5,PSBPARM6,PSBPARM7) ; SEND AN E-MAIL
....D CLEAN^PSBVT,PSJ1^PSBVT(DFN,PSBXTMP) ;Reset Variables
....S X=PSBPARM6 K PSBPARM3,PSBPARM5,PSBPARM6,PSBPARM7
...K PSBLCK S:(PSBSTUS']"") PSBSTUS="U" I PSBSTUS'="N",($G(PSBSTUS)'="X") S PSBFLAG=1,PSBHSTA(YZ,$G(PSBSTUS))="ORIG"_U_X
...D:PSBSTUS="N"
....S $P(PSBREC,U,11)=""
....S Z="" F S Z=$O(^PSB(53.79,X,.9,Z),-1) Q:'Z Q:PSBFLAG=1 S PSBDATA=$G(^(Z,0)) D
.....I (PSBDATA["Set to 'NOT GIVEN'")!(PSBDATA["Set to 'GIVEN'")!(PSBDATA["Set to 'REFUSED'")!(PSBDATA["Set to 'HELD'")!(PSBDATA["Set to 'MISSING DOSE'")!(PSBDATA["Set to 'REMOVED'") S PSBCNT=PSBCNT+1
.....I (PSBDATA["STATUS 'HELD'")!(PSBDATA["STATUS 'GIVEN'")!(PSBDATA["STATUS 'REFUSED'")!(PSBDATA["STATUS 'MISSING DOSE'")!(PSBDATA["STATUS 'REMOVED'") S PSBCNT=PSBCNT+1
.....I PSBCNT#2=0,PSBDATA["'REFUSED'" S PSBSTUS="R" D LAST^PSBVDLU1
.....I PSBCNT#2=0,PSBDATA["'HELD'" S PSBSTUS="H" D LAST^PSBVDLU1
.....I PSBCNT#2=0,PSBDATA["'MISSING DOSE'" S PSBSTUS="M" D LAST^PSBVDLU1
.....I PSBFLAG=1,'$D(PSBHSTA($P(PSBREC,U,11),$G(PSBSTUS))) S PSBHSTA($P(PSBREC,U,11),$G(PSBSTUS))=Z_U_X
.I $D(PSBHSTA) S $P(PSBREC,U,11)=$O(PSBHSTA(""),-1),PSBSTUS=$O(PSBHSTA($P(PSBREC,U,11),""),-1) M PSBHSTAX(PSBOIT)=PSBHSTA K PSBHSTA ;last action date/time
.S $P(PSBREC,U,12)="" ;med log ien inserted below for actual date
.S $P(PSBREC,U,13)="" ;med log status inserted below for actual date
.S $P(PSBREC,U,14)="" ; admin date inserted below
.S $P(PSBREC,U,15)=PSBOIT ; OI Pointer
.S $P(PSBREC,U,16)=PSBNJECT ;med route injectable 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:PSBDOSEF?1"CAP".E!(PSBDOSEF?1"TAB".E)!(PSBDOSEF="PATCH")!(PSBDOSEF="GUM,CHEWABLE") $P(PSBREC,U,18)=PSBDOSEF ;dosage form, add Gum,Chewable for HD208693
.S $P(PSBREC,U,20)=$S((PSBSTUS="X")!(PSBSTUS="N"):"",1:PSBSTUS) ; last action status
.S $P(PSBREC,U,21)=PSBOST
.S $P(PSBREC,U,22)=PSBOSTS
.S $P(PSBREC,U,26)=PSBOSP
.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)
.;*68 add last injection site/dermal site *83
.S $P(PSBREC,U,30)=$$LASTSITE^PSBINJEC(DFN,PSBOIT) ;can be null *83
.; piece 31 reserved by IVPB tab
.S $P(PSBREC,U,32)=$G(PSBCLORD) ;clinic name *70
.S $P(PSBREC,U,33)=$G(PSBCLIEN) ;clinic ien ptr *70
.; piece 34-35 reserved for Remove meds and set by PSBVDLU1
.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,PSBFLAG)="0"
.F Y=0:0 S Y=$O(PSBDDA(Y)) Q:'Y D
..I $P(PSBDDA(Y),U,5)=$P(%,".") S PSBFLAG=1 ;If drug was inactivated
..Q:$P(PSBDDA(Y),U,5)&($P(PSBDDA(Y),U,5)<%) ; Inactive
..S:$P(PSBDDA(Y),U,4)="" $P(PSBDDA(Y),U,4)=1
..S PSBDDS=PSBDDS_U_$P(PSBDDA(Y),U,1,4)
..S $P(PSBDDS,U,1)=PSBDDS+1
.;
.;** Begin admin time calculations & add to TMP for Results to GUI **
.;
.; On-Call One Time PRN orders
.S PSBQRR=0
.;*70 if Order start dates > than the day being viewed, don't show
.I "^O^OC^P^"[(U_PSBSCHT_U) D Q
..Q:PSBCLINORD&($P(PSBOST,".")>PSBDT) ;*70
..D ADD^PSBVDLU1(PSBREC,PSBOTXT,PSBNOW\1,PSBDDS,PSBSOLS,PSBADDS,"UDTAB")
.;
.; Now we deal with only continuous
.; process admin times
.;
.; Display an order on the VDL based on the frequency received from IPM **PSB*2.0*3
.S (PSBYES,PSBODD,PSBYTF)=0
.I PSBSCH="" D ERROR^PSBMLU(PSBONX,PSBOITX,DFN,"No Schedule on this order")
.S:$$PSBDCHK1^PSBVT1(PSBSCH) PSBYES=1
.I PSBYES,PSBADST="" D ERROR^PSBMLU(PSBONX,PSBOITX,DFN,"Admin times required",PSBSCH) Q
.F I=1:1 Q:$P(PSBSCH,"-",I)="" I $P(PSBSCH,"-",I)?2N!($P(PSBSCH,"-",I)?4N) S PSBYES=1,PSBYTF=1
.I PSBSCHT="C",PSBYTF="1",PSBADST="" D ERROR^PSBMLU(PSBONX,PSBOITX,DFN,"Admin times required",PSBSCH) Q
.S PSBFREQ=$$GETFREQ^PSBVDLU1(DFN,PSBONX)
.I PSBFREQ="O" S PSBFREQ=1440
.I PSBFREQ="D" S PSBFREQ=""
.I 'PSBYES,PSBFREQ<1 D ERROR^PSBMLU(PSBONX,PSBOITX,DFN,"Invalid frequency received from order",PSBSCH) Q
.I (PSBADST="")&(+PSBFREQ>0) D ODDSCH^PSBVDLU1("UDTAB") Q ;calculate admin times based on frequency
.; No admin times, MAYDAY MAYDAY!!
.I +PSBFREQ>0 I (PSBFREQ#1440'=0),(1440#PSBFREQ'=0) S PSBODD=1
.I PSBODD,PSBADST'="" D ERROR^PSBMLU(PSBONX,PSBOITX,DFN,"Administration Times on ODD SCHEDULE",PSBSCH) Q
.;
.;** Process admin times against beginning and ending date
.; build all orders for both days.
.;
.;loop through admin times string and add to Results
.F PSBY=1:1 Q:$P(PSBADST,"-",PSBY)="" D
..;For invalid admin times
..I ($P(PSBADST,"-",PSBY)'?2N)&($P(PSBADST,"-",PSBY)'?4N) D ERROR^PSBMLU(PSBONX,PSBOITX,DFN,"Invalid Admin times",PSBSCH)
..;
..; apply this time to beginning window date
..S PSB=+(PSBWBEG\1_"."_$P(PSBADST,"-",PSBY))
..;
..D:(PSB'<PSBWBEG)&(PSB'>PSBWEND) ;Make sure in the 12hr window
...D:(PSB'<PSBOST)&(PSB<PSBOSP) ;Make sure this time is active
....D:$$OKAY^PSBVDLU1(PSBOST,PSB,PSBSCH,PSBONX,PSBOITX,PSBFREQ,PSBOSTS) ; Okay on this date?
.....;*83 ADD Api now will calc & add MRR remove code & time to 34^35
.....D ADD^PSBVDLU1(PSBREC,PSBOTXT,PSB,PSBDDS,PSBSOLS,PSBADDS,"UDTAB")
..;
..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(PSBADST,"-",PSBY))
..D:(PSB'<PSBWBEG)&(PSB'>PSBWEND) ; Make sure it is in the window
...D:(PSB'<PSBOST)&(PSB<PSBOSP) ; Make sure this time is active
....D:$$OKAY^PSBVDLU1(PSBOST,PSB,PSBSCH,PSBONX,PSBOITX,PSBFREQ,PSBOSTS) ; Okay on this date?
.....D ADD^PSBVDLU1(PSBREC,PSBOTXT,PSB,PSBDDS,PSBSOLS,PSBADDS,"UDTAB")
.;
.K PSBSTUS
;
1 K PSBREC
D EN^PSBVDLPA ;find patches Given not removed and add to VDL
D EN^PSBVDLRM ;find MRR meds Given not removed and add to VDL *83
;
;add initials of verifying pharmacist/verifying nurse
D:PSBTAB="UDTAB" VNURSE^PSBVDLU1("UDTAB")
D CLEAN^PSBVT ;kills all PSB variables
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSBVDLUD 10915 printed Apr 09, 2024@20:46:11 Page 2
PSBVDLUD ;BIRMINGHAM/EFC-BCMA UNIT DOSE VIRTUAL DUE LIST FUNCTIONS ;03/06/16 3:06pm
+1 ;;3.0;BAR CODE MED ADMIN;**11,13,38,32,58,68,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 ; $$GET^XPAR/2263
+6 ; GETPROVL^PSGSICH1/5653
+7 ; INTRDIC^PSGSICH1/5654
+8 ;
+9 ;*58 - add 29th piece to Results for Override/Intervention flag 1/0
+10 ;*68 - add 30th piece to Results for Last Injection Site
+11 ;*70 - add 32nd piece to Results for Clinic Order name for CO's
+12 ; - add 33rd piece to Results for Clinic ien ptr to file #44
+13 ;*83 - add 34th & 35th piece to Results via ADD^PSBVDLU1
+14 ; add call to new routine PSBVDLRM for placing MRR meds on VDL
+15 ; - Clinic Orders should show up on VDL's when start order date
+16 ; is Today now ignores the time portion of that field.
+17 ;*106- add Hazardous to Handle & Dispose flags 36 & 37
+18 ;
EN(DFN,PSBDT) ;
+1 ;
+2 ; Description:
+3 ; Returns the current unit dose order set for today to display
+4 ; on the client VDL
+5 ;
+6 NEW PSBDATA,PSBTBOUT
+7 ;new here instead of kill in PA rtn *83
NEW PSBONVDL
+8 NEW ADM,MISSED,IEN,STUS
+9 SET PSBTBOUT=0
+10 ;
+11 ;This routine now re-uses the ^TMP("PSJ",$J global built in PSBVDLTB
+12 ;
+13 if $GET(^TMP("PSJ",$JOB,1,0))=-1
GOTO 1
+14 FOR PSBX=0:0
SET PSBX=$ORDER(^TMP("PSJ",$JOB,PSBX))
if ('PSBX)!(PSBTBOUT)
QUIT
Begin DoDot:1
+15 NEW PSBRTNOW
SET PSBRTNOW=$$NOW^XLFDT()
+16 if (PSBTAB'="UDTAB")&($GET(^TMP("PSB",$JOB,"UDTAB",2))>0)
SET PSBTBOUT=1
+17 DO CLEAN^PSBVT
DO PSJ^PSBVT(PSBX)
+18 ;
+19 ; << Standard checks for ALL orders >>
+20 ;
+21 ;No IVs on UD tab
if PSBONX["V"
QUIT
+22 ;No Pending Orders
if PSBONX["P"
QUIT
+23 ;Order Start Date/Time > admin window
if PSBOST>PSBWADM
QUIT
+24 ;CO Order future start check now based on the date only Not time *83
+25 if ($GET(PSBCLORD)]"")&($PIECE(PSBOST,".")>$PIECE(PSBRTNOW,"."))
QUIT
+26 ;For Non one-times Order Stop Date/Time < vdl window
if PSBOSP<PSBWBEG
QUIT
+27 ;Is it DC'd
if PSBOSTS["D"
QUIT
+28 ;Is it marked DO NOT GIVE!
if PSBNGF
QUIT
+29 ;Is it IV push
if PSBIVPSH
QUIT
+30 ;
+31 ; Non One-Times with stop date/time < now
+32 ;
+33 DO NOW^%DTC
+34 if PSBOSP<%
QUIT
+35 ;
+36 ; include Active, Renewed, ReInstated and On Call
+37 ; (Is it not one time)&(Is it not active or renewed or On Call)
+38 IF PSBSCHT'="O"
IF PSBOSTS'="A"
IF PSBOSTS'="H"
IF PSBOSTS'="R"
IF PSBOSTS'="RE"
IF PSBOSTS'="O"
QUIT
+39 ;
+40 ; Is One Time Given
+41 ;
+42 IF PSBSCHT="O"
Begin DoDot:2
+43 SET (PSBGVN,X,Y)=""
+44 FOR
SET X=$ORDER(^PSB(53.79,"AOIP",DFN,PSBOIT,X),-1)
if 'X
QUIT
Begin DoDot:3
+45 FOR
SET Y=$ORDER(^PSB(53.79,"AOIP",DFN,PSBOIT,X,Y),-1)
if 'Y
QUIT
Begin DoDot:4
+46 IF $PIECE(^PSB(53.79,Y,.1),U)=PSBONX
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
+47 ;
+48 ; How long does One Time remain on VDL ??
+49 SET PSBRMN=1
+50 IF PSBSCHT="O"
IF PSBOSP'=PSBOST&(%>PSBOSP)
SET PSBRMN=0
+51 if 'PSBRMN
QUIT
+52 ; Is On-Call Given, Can it be given more than once
+53 ;
+54 IF PSBSCHT="OC"
Begin DoDot:2
+55 SET (PSBGVN,X,Y)=""
+56 FOR
SET X=$ORDER(^PSB(53.79,"AOIP",DFN,PSBOIT,X),-1)
if 'X
QUIT
Begin DoDot:3
+57 FOR
SET Y=$ORDER(^PSB(53.79,"AOIP",DFN,PSBOIT,X,Y),-1)
if 'Y
QUIT
Begin DoDot:4
+58 IF $PIECE(^PSB(53.79,Y,.1),U)=PSBONX
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
+59 ;
+60 SET PSBREC=""
+61 ; dfn
SET $PIECE(PSBREC,U,1)=DFN
+62 ; order
SET $PIECE(PSBREC,U,2)=PSBONX
+63 ; order ien
SET $PIECE(PSBREC,U,3)=PSBON
+64 ; iv/ud/pending
SET $PIECE(PSBREC,U,4)=PSBOTYP
+65 ; schedule type
SET $PIECE(PSBREC,U,5)=PSBSCHT
+66 ; schedule
SET $PIECE(PSBREC,U,6)=PSBSCH
+67 ; self med
SET $PIECE(PSBREC,U,7)=$SELECT(PSBHSM:"HSM",PSBSM:"SM",1:"")
+68 ; drugname
SET $PIECE(PSBREC,U,8)=PSBOITX
+69 ; dosage
SET $PIECE(PSBREC,U,9)=PSBDOSE_" "_PSBIFR
+70 ; med route
SET $PIECE(PSBREC,U,10)=PSBMR
+71 ; Last Given from the AOIP X-Ref - not given status not excepted
+72 SET (PSBCNT,PSBFLAG)=0
SET (YZ,PSBSTUS,PSBADMER)=""
KILL PSBHSTA,PSBHSTAX
+73 FOR XZ=1:1:20
SET YZ=$ORDER(^PSB(53.79,"AOIP",DFN,PSBOIT,YZ),-1)
SET (PSBCNT,PSBFLAG)=0
if YZ=""
QUIT
Begin DoDot:2
+74 if YZ>0
SET $PIECE(PSBREC,U,11)=YZ
+75 SET X=""
FOR
SET X=$ORDER(^PSB(53.79,"AOIP",DFN,PSBOIT,YZ,X),-1)
if X=""
QUIT
Begin DoDot:3
+76 KILL PSBLCK
LOCK +^PSB(53.79,X):1
IF $TEST
LOCK -^PSB(53.79,X)
SET PSBLCK=1
+77 SET PSBSTUS=$PIECE(^PSB(53.79,X,0),U,9)
+78 IF $GET(PSBSTUS)=""
if '$GET(PSBLCK)
SET PSBSTUS="X"
IF $GET(PSBLCK)
SET PSBADMER=1
Begin DoDot:4
+79 KILL PSBPARM3,PSBPARM5,PSBPARM6,PSBPARM7
+80 SET PSBPARM6=X
SET Y=$PIECE(^PSB(53.79,X,.1),U,3)
DO DD^%DT
SET PSBPARM3=Y
SET Y=$PIECE(^PSB(53.79,X,0),U,6)
DO DD^%DT
SET PSBPARM5=Y
+81 SET PSBPARM7=$PIECE(^PSB(53.79,X,0),U,7)
SET PSBPARM7="( # "_PSBPARM7_" ) "_$$GET1^DIQ(200,PSBPARM7_",",.01)
+82 KILL PSBXTMP
SET PSBXTMP=PSBONX
+83 DO CLEAN^PSBVT
DO PSJ1^PSBVT(DFN,$$GET1^DIQ(53.79,PSBPARM6_",",.11))
+84 ; SEND AN E-MAIL
DO ERROR^PSBMLU(PSBONX,PSBOITX,DFN,PSBPARM3_" admin's ACTION STATUS is ""UNKNOWN"".",PSBSCH,PSBPARM5,PSBPARM6,PSBPARM7)
+85 ;Reset Variables
DO CLEAN^PSBVT
DO PSJ1^PSBVT(DFN,PSBXTMP)
+86 SET X=PSBPARM6
KILL PSBPARM3,PSBPARM5,PSBPARM6,PSBPARM7
End DoDot:4
+87 KILL PSBLCK
if (PSBSTUS']"")
SET PSBSTUS="U"
IF PSBSTUS'="N"
IF ($GET(PSBSTUS)'="X")
SET PSBFLAG=1
SET PSBHSTA(YZ,$GET(PSBSTUS))="ORIG"_U_X
+88 if PSBSTUS="N"
Begin DoDot:4
+89 SET $PIECE(PSBREC,U,11)=""
+90 SET Z=""
FOR
SET Z=$ORDER(^PSB(53.79,X,.9,Z),-1)
if 'Z
QUIT
if PSBFLAG=1
QUIT
SET PSBDATA=$GET(^(Z,0))
Begin DoDot:5
+91 IF (PSBDATA["Set to 'NOT GIVEN'")!(PSBDATA["Set to 'GIVEN'")!(PSBDATA["Set to 'REFUSED'")!(PSBDATA["Set to 'HELD'")!(PSBDATA["Set to 'MISSING DOSE'")!(PSBDATA["Set to 'REMOVED'")
SET PSBCNT=PSBCNT+1
+92 IF (PSBDATA["STATUS 'HELD'")!(PSBDATA["STATUS 'GIVEN'")!(PSBDATA["STATUS 'REFUSED'")!(PSBDATA["STATUS 'MISSING DOSE'")!(PSBDATA["STATUS 'REMOVED'")
SET PSBCNT=PSBCNT+1
+93 IF PSBCNT#2=0
IF PSBDATA["'REFUSED'"
SET PSBSTUS="R"
DO LAST^PSBVDLU1
+94 IF PSBCNT#2=0
IF PSBDATA["'HELD'"
SET PSBSTUS="H"
DO LAST^PSBVDLU1
+95 IF PSBCNT#2=0
IF PSBDATA["'MISSING DOSE'"
SET PSBSTUS="M"
DO LAST^PSBVDLU1
+96 IF PSBFLAG=1
IF '$DATA(PSBHSTA($PIECE(PSBREC,U,11),$GET(PSBSTUS)))
SET PSBHSTA($PIECE(PSBREC,U,11),$GET(PSBSTUS))=Z_U_X
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
+97 ;last action date/time
IF $DATA(PSBHSTA)
SET $PIECE(PSBREC,U,11)=$ORDER(PSBHSTA(""),-1)
SET PSBSTUS=$ORDER(PSBHSTA($PIECE(PSBREC,U,11),""),-1)
MERGE PSBHSTAX(PSBOIT)=PSBHSTA
KILL PSBHSTA
+98 ;med log ien inserted below for actual date
SET $PIECE(PSBREC,U,12)=""
+99 ;med log status inserted below for actual date
SET $PIECE(PSBREC,U,13)=""
+100 ; admin date inserted below
SET $PIECE(PSBREC,U,14)=""
+101 ; OI Pointer
SET $PIECE(PSBREC,U,15)=PSBOIT
+102 ;med route injectable flag
SET $PIECE(PSBREC,U,16)=PSBNJECT
+103 ; Variable dosage entered as ####-####?
+104 IF $PIECE(PSBREC,U,9)?1.4N1"-"1.4N.E
SET $PIECE(PSBREC,U,17)=1
+105 IF '$TEST
SET $PIECE(PSBREC,U,17)=0
+106 ;dosage form, add Gum,Chewable for HD208693
if PSBDOSEF?1"CAP".E!(PSBDOSEF?1"TAB".E)!(PSBDOSEF="PATCH")!(PSBDOSEF="GUM,CHEWABLE")
SET $PIECE(PSBREC,U,18)=PSBDOSEF
+107 ; last action status
SET $PIECE(PSBREC,U,20)=$SELECT((PSBSTUS="X")!(PSBSTUS="N"):"",1:PSBSTUS)
+108 SET $PIECE(PSBREC,U,21)=PSBOST
+109 SET $PIECE(PSBREC,U,22)=PSBOSTS
+110 SET $PIECE(PSBREC,U,26)=PSBOSP
+111 SET $PIECE(PSBREC,U,27)=$$LASTG^PSBCSUTL(DFN,PSBOIT)
+112 ;*58 determine if override or intervn exists, send 1/0 (true/false)
+113 NEW PSBARR
DO GETPROVL^PSGSICH1(DFN,PSBONX,.PSBARR)
+114 IF $ORDER(PSBARR(""))=""
DO INTRDIC^PSGSICH1(DFN,PSBONX,.PSBARR,2)
+115 SET $PIECE(PSBREC,U,29)=$SELECT($ORDER(PSBARR(""))]"":1,1:0)
+116 ;*68 add last injection site/dermal site *83
+117 ;can be null *83
SET $PIECE(PSBREC,U,30)=$$LASTSITE^PSBINJEC(DFN,PSBOIT)
+118 ; piece 31 reserved by IVPB tab
+119 ;clinic name *70
SET $PIECE(PSBREC,U,32)=$GET(PSBCLORD)
+120 ;clinic ien ptr *70
SET $PIECE(PSBREC,U,33)=$GET(PSBCLIEN)
+121 ; piece 34-35 reserved for Remove meds and set by PSBVDLU1
+122 ;Hazardous to Handle *106
SET $PIECE(PSBREC,U,36)=$GET(PSBHAZHN)
+123 ;Hazardous to Dispose *106
SET $PIECE(PSBREC,U,37)=$GET(PSBHAZDS)
+124 ;
+125 ; Gather Dispense Drugs
+126 DO NOW^%DTC
+127 SET (PSBDDS,PSBSOLS,PSBADDS,PSBFLAG)="0"
+128 FOR Y=0:0
SET Y=$ORDER(PSBDDA(Y))
if 'Y
QUIT
Begin DoDot:2
+129 ;If drug was inactivated
IF $PIECE(PSBDDA(Y),U,5)=$PIECE(%,".")
SET PSBFLAG=1
+130 ; Inactive
if $PIECE(PSBDDA(Y),U,5)&($PIECE(PSBDDA(Y),U,5)<%)
QUIT
+131 if $PIECE(PSBDDA(Y),U,4)=""
SET $PIECE(PSBDDA(Y),U,4)=1
+132 SET PSBDDS=PSBDDS_U_$PIECE(PSBDDA(Y),U,1,4)
+133 SET $PIECE(PSBDDS,U,1)=PSBDDS+1
End DoDot:2
+134 ;
+135 ;** Begin admin time calculations & add to TMP for Results to GUI **
+136 ;
+137 ; On-Call One Time PRN orders
+138 SET PSBQRR=0
+139 ;*70 if Order start dates > than the day being viewed, don't show
+140 IF "^O^OC^P^"[(U_PSBSCHT_U)
Begin DoDot:2
+141 ;*70
if PSBCLINORD&($PIECE(PSBOST,".")>PSBDT)
QUIT
+142 DO ADD^PSBVDLU1(PSBREC,PSBOTXT,PSBNOW\1,PSBDDS,PSBSOLS,PSBADDS,"UDTAB")
End DoDot:2
QUIT
+143 ;
+144 ; Now we deal with only continuous
+145 ; process admin times
+146 ;
+147 ; Display an order on the VDL based on the frequency received from IPM **PSB*2.0*3
+148 SET (PSBYES,PSBODD,PSBYTF)=0
+149 IF PSBSCH=""
DO ERROR^PSBMLU(PSBONX,PSBOITX,DFN,"No Schedule on this order")
+150 if $$PSBDCHK1^PSBVT1(PSBSCH)
SET PSBYES=1
+151 IF PSBYES
IF PSBADST=""
DO ERROR^PSBMLU(PSBONX,PSBOITX,DFN,"Admin times required",PSBSCH)
QUIT
+152 FOR I=1:1
if $PIECE(PSBSCH,"-",I)=""
QUIT
IF $PIECE(PSBSCH,"-",I)?2N!($PIECE(PSBSCH,"-",I)?4N)
SET PSBYES=1
SET PSBYTF=1
+153 IF PSBSCHT="C"
IF PSBYTF="1"
IF PSBADST=""
DO ERROR^PSBMLU(PSBONX,PSBOITX,DFN,"Admin times required",PSBSCH)
QUIT
+154 SET PSBFREQ=$$GETFREQ^PSBVDLU1(DFN,PSBONX)
+155 IF PSBFREQ="O"
SET PSBFREQ=1440
+156 IF PSBFREQ="D"
SET PSBFREQ=""
+157 IF 'PSBYES
IF PSBFREQ<1
DO ERROR^PSBMLU(PSBONX,PSBOITX,DFN,"Invalid frequency received from order",PSBSCH)
QUIT
+158 ;calculate admin times based on frequency
IF (PSBADST="")&(+PSBFREQ>0)
DO ODDSCH^PSBVDLU1("UDTAB")
QUIT
+159 ; No admin times, MAYDAY MAYDAY!!
+160 IF +PSBFREQ>0
IF (PSBFREQ#1440'=0)
IF (1440#PSBFREQ'=0)
SET PSBODD=1
+161 IF PSBODD
IF PSBADST'=""
DO ERROR^PSBMLU(PSBONX,PSBOITX,DFN,"Administration Times on ODD SCHEDULE",PSBSCH)
QUIT
+162 ;
+163 ;** Process admin times against beginning and ending date
+164 ; build all orders for both days.
+165 ;
+166 ;loop through admin times string and add to Results
+167 FOR PSBY=1:1
if $PIECE(PSBADST,"-",PSBY)=""
QUIT
Begin DoDot:2
+168 ;For invalid admin times
+169 IF ($PIECE(PSBADST,"-",PSBY)'?2N)&($PIECE(PSBADST,"-",PSBY)'?4N)
DO ERROR^PSBMLU(PSBONX,PSBOITX,DFN,"Invalid Admin times",PSBSCH)
+170 ;
+171 ; apply this time to beginning window date
+172 SET PSB=+(PSBWBEG\1_"."_$PIECE(PSBADST,"-",PSBY))
+173 ;
+174 ;Make sure in the 12hr window
if (PSB'<PSBWBEG)&(PSB'>PSBWEND)
Begin DoDot:3
+175 ;Make sure this time is active
if (PSB'<PSBOST)&(PSB<PSBOSP)
Begin DoDot:4
+176 ; Okay on this date?
if $$OKAY^PSBVDLU1(PSBOST,PSB,PSBSCH,PSBONX,PSBOITX,PSBFREQ,PSBOSTS)
Begin DoDot:5
+177 ;*83 ADD Api now will calc & add MRR remove code & time to 34^35
+178 DO ADD^PSBVDLU1(PSBREC,PSBOTXT,PSB,PSBDDS,PSBSOLS,PSBADDS,"UDTAB")
End DoDot:5
End DoDot:4
End DoDot:3
+179 ;
+180 ; Window only has one day rare but possible
if (PSBWBEG\1)=(PSBWEND\1)
QUIT
+181 ;
+182 ; apply this time to the ending window date
+183 SET PSB=+(PSBWEND\1_"."_$PIECE(PSBADST,"-",PSBY))
+184 ; Make sure it is in the window
if (PSB'<PSBWBEG)&(PSB'>PSBWEND)
Begin DoDot:3
+185 ; Make sure this time is active
if (PSB'<PSBOST)&(PSB<PSBOSP)
Begin DoDot:4
+186 ; Okay on this date?
if $$OKAY^PSBVDLU1(PSBOST,PSB,PSBSCH,PSBONX,PSBOITX,PSBFREQ,PSBOSTS)
Begin DoDot:5
+187 DO ADD^PSBVDLU1(PSBREC,PSBOTXT,PSB,PSBDDS,PSBSOLS,PSBADDS,"UDTAB")
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
+188 ;
+189 KILL PSBSTUS
End DoDot:1
+190 ;
1 KILL PSBREC
+1 ;find patches Given not removed and add to VDL
DO EN^PSBVDLPA
+2 ;find MRR meds Given not removed and add to VDL *83
DO EN^PSBVDLRM
+3 ;
+4 ;add initials of verifying pharmacist/verifying nurse
+5 if PSBTAB="UDTAB"
DO VNURSE^PSBVDLU1("UDTAB")
+6 ;kills all PSB variables
DO CLEAN^PSBVT
+7 QUIT
