PSBMLVAL ;BIRMINGHAM/EFC-BCMA MED LOG VALIDATION ;Mar 2004
;;3.0;BAR CODE MED ADMIN;**88**;Mar 2004;Build 11
;Per VA Directive 6402, this routine should not be modified.
;
;
VAL(RESULTS,DFN,PSBIEN,PSBTYPE,PSBADMIN) ;
;
; RPC: PSB VALIDATE ORDER
;
; Description: Final check of order against an actual administration
; date/time used immediately after scanned med has been
; validated to be a good unadministered order and by the
; PSBODL (Due List) output.
;
; Variables: DFN: Patient IEN
; PSBIEN: Order IEN
; PSBTYPE: U:Unit Dose/V:IV
; PSBADMIN: Scheduled Administration Time
;
N PSBOKAY,PSBORD,PSBSCHT,PSBOST,PSBOSP,PSBDT,PSBDA,PSBNOW
;
K PSBORD
D PSJ1^PSBVT(DFN,PSBIEN_PSBTYPE)
S PSBCNT=0
S PSBOKAY="-1^***Unable to determine administration" ; Default Flag
D NOW^%DTC
;
;
I PSBSCHT'="O"&(%>PSBOSP) S RESULTS(0)="-1^Order Not Active",PSBCNT=2 Q
; Validate an IV
I PSBONX?.N1"V" D S RESULTS(0)=PSBOKAY Q
.I PSBOSTS'="A"&(PSBOSTS'="R")&(PSBOSTS'="O") S PSBOKAY="-1^Order Not Active",PSBCNT=2 Q ;Include On Call Orders, PSB*3*88
.I PSBNGF S PSBOKAY="-1^marked DO NOT GIVE",PSBCNT=2 Q
.I PSBSCHT="O" D Q ; Make sure One Time is not given.
..I $D(^PSB(53.79,"AORD",DFN,PSBONX)) S PSBOKAY="-1^Already Given",PSBCNT=2
..E S PSBOKAY="0^Okay to administer"
.S PSBOKAY="0^Okay to administer"
; Validate a Continuous Order
D:PSBSCHT="C"
.S (PSBGVN,X,Y)=""
.I PSBOSTS'="A"&(PSBOSTS'="R") S PSBOKAY="-1^Order Not Active",PSBCNT=2 Q
.I PSBNGF S PSBOKAY="-1^marked DO NOT GIVE",PSBCNT=2 Q
.I $D(^PSB(53.79,"AORD",DFN,PSBIEN_PSBTYPE,PSBADMIN)) D Q:X
..S X=$O(^PSB(53.79,"AORD",DFN,PSBIEN_PSBTYPE,PSBADMIN,X)) Q:'X
..S X=$S($P($G(^PSB(53.79,+X,0)),U,9)="G":1,1:0) Q:'X
..S PSBOKAY="-1^Dose already on medication log",PSBCNT=2
.; Minutes before
.S PSBWIN1=$$GET^XPAR("DIV","PSB ADMIN BEFORE")*-1
.; Minutes After
.S PSBWIN2=$$GET^XPAR("DIV","PSB ADMIN AFTER")
.D NOW^%DTC S PSBMIN=$$DIFF^PSBUTL(PSBADMIN,%)
.; PENDING A PC SOLUTION!
.I PSBMIN<PSBWIN1 S PSBOKAY="1^Admin is "_(PSBMIN*-1)_" minutes before the scheduled administration time" Q
.I PSBMIN>PSBWIN2 S PSBOKAY="1^Admin is "_(PSBMIN)_" minutes after the scheduled administration time" Q
.S PSBOKAY="0^Okay to administer"
; Validate a PRN Order
D:PSBSCHT="P"
.I PSBOSTS'="A"&(PSBOSTS'="R") S PSBOKAY="-1^Order Not Active",PSBCNT=2 Q
.I PSBNGF S PSBOKAY="-1^marked DO NOT GIVE",PSBCNT=2 Q
.; CHECK Q4H STUFF SEND 1^TO SOON IF TOO SOON.
.S PSBOKAY="1^Brief Administration History"
.; Get Last Four Givens
.S PSBDT=""
.F S PSBDT=$O(^PSB(53.79,"AOIP",DFN,PSBOIT,PSBDT),-1) Q:PSBDT="" D
..S PSBDA=""
..F S PSBDA=$O(^PSB(53.79,"AOIP",DFN,PSBOIT,PSBDT,PSBDA),-1) Q:'PSBDA D
...Q:$P(^PSB(53.79,PSBDA,0),U,9)="N"
...S X=$$GET1^DIQ(53.79,PSBDA_",",.06)_" "
...S X=X_$$GET1^DIQ(53.79,PSBDA_",",.09)_" "
...S X=X_$$GET1^DIQ(53.79,PSBDA_",",.12)_" "
...S X=X_$$GET1^DIQ(53.79,PSBDA_",",.21)_" "
...S X=X_$$GET1^DIQ(53.79,PSBDA_",",.16)_" "
...S PSBOKAY($O(PSBOKAY(""),-1)+1)=X
...S:$D(PSBOKAY(4)) PSBDT=0
; Validate a One-Time Order
D:PSBSCHT="O"
.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 S:($P(^PSB(53.79,Y,.1),U)=PSBONX)&($P(^PSB(53.79,Y,0),U,9)="G") PSBGVN=1,(X,Y)=0
.I PSBGVN S PSBOKAY="-1^Dose Already on medication Log",PSBCNT=2 Q
.; One Time are automatically expired so we don't check STATUS here
.I PSBNGF S PSBOKAY="-1^marked DO NOT GIVE",PSBCNT=2 Q
.S PSBOKAY="0^Okay to administer"
; Validate an On Call Order
D:PSBSCHT="OC"
.S PSBOKAY="0^Okay to administer",(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 S:$P(^PSB(53.79,Y,.1),U)=PSBONX PSBGVN=1,(X,Y)=0
.I PSBGVN&('$$GET^XPAR("DIV","PSB ADMIN MULTIPLE ONCALL")) S PSBOKAY="-1^Dose Already on medication Log",PSBCNT=2 Q
.I PSBOSTS'="A"&(PSBOSTS'="R") S PSBOKAY="-1^Order Not Active",PSBCNT=2 Q
.I PSBNGF S PSBOKAY="-1^marked DO NOT GIVE",PSBCNT=2 Q
.S PSBOKAY="0^Okay to administer"
;
D:+PSBOKAY'=-1
.N PSBDIFF,Y,X,PSBSTUS
.; Ok, now we know it is on-call or cont and not on the log.
.D:(PSBSCHT="C")!(PSBSCHT="OC"&('$G(PSBGVN)))
..S Y=$O(^PSB(53.79,"AOIP",DFN,PSBOIT,""),-1)
..S PSBDIFF=$$FMDIFF^XLFDT($$NOW^XLFDT(),Y,2)
..Q:PSBDIFF>7200 ; Greater than 2 hours
..;Check for the status of the medication and insert status in the text
..I Y]"" S X=$O(^PSB(53.79,"AOIP",DFN,PSBOIT,Y,""),-1),PSBSTUS=$P(^PSB(53.79,X,0),U,9)
..S PSBSTUS=$S(PSBSTUS="G":"GIVEN",PSBSTUS="H":"HELD",1:"REFUSED")
..S Y="*** NOTICE, "_PSBOITX_" was "_PSBSTUS_" "_(PSBDIFF\60)_" minutes ago."
..I +PSBOKAY=1 S PSBOKAY(1)=Y
..E S PSBOKAY="1^"_Y
;
D NOW^%DTC
I PSBSCHT'="O"&(%<($$FMADD^XLFDT(PSBOST,"","",$$GET^XPAR("ALL","PSB ADMIN BEFORE")*-1))) S RESULTS(0)="-1^Order Not Active" I PSBCNT=0 S PSBCNT=1 Q
;
S RESULTS(0)=PSBOKAY
F X=1:1 Q:'$D(PSBOKAY(X)) S RESULTS($O(RESULTS(""),-1)+1)=PSBOKAY(X)
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSBMLVAL 5169 printed Nov 22, 2024@16:50:28 Page 2
PSBMLVAL ;BIRMINGHAM/EFC-BCMA MED LOG VALIDATION ;Mar 2004
+1 ;;3.0;BAR CODE MED ADMIN;**88**;Mar 2004;Build 11
+2 ;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ;
VAL(RESULTS,DFN,PSBIEN,PSBTYPE,PSBADMIN) ;
+1 ;
+2 ; RPC: PSB VALIDATE ORDER
+3 ;
+4 ; Description: Final check of order against an actual administration
+5 ; date/time used immediately after scanned med has been
+6 ; validated to be a good unadministered order and by the
+7 ; PSBODL (Due List) output.
+8 ;
+9 ; Variables: DFN: Patient IEN
+10 ; PSBIEN: Order IEN
+11 ; PSBTYPE: U:Unit Dose/V:IV
+12 ; PSBADMIN: Scheduled Administration Time
+13 ;
+14 NEW PSBOKAY,PSBORD,PSBSCHT,PSBOST,PSBOSP,PSBDT,PSBDA,PSBNOW
+15 ;
+16 KILL PSBORD
+17 DO PSJ1^PSBVT(DFN,PSBIEN_PSBTYPE)
+18 SET PSBCNT=0
+19 ; Default Flag
SET PSBOKAY="-1^***Unable to determine administration"
+20 DO NOW^%DTC
+21 ;
+22 ;
+23 IF PSBSCHT'="O"&(%>PSBOSP)
SET RESULTS(0)="-1^Order Not Active"
SET PSBCNT=2
QUIT
+24 ; Validate an IV
+25 IF PSBONX?.N1"V"
Begin DoDot:1
+26 ;Include On Call Orders, PSB*3*88
IF PSBOSTS'="A"&(PSBOSTS'="R")&(PSBOSTS'="O")
SET PSBOKAY="-1^Order Not Active"
SET PSBCNT=2
QUIT
+27 IF PSBNGF
SET PSBOKAY="-1^marked DO NOT GIVE"
SET PSBCNT=2
QUIT
+28 ; Make sure One Time is not given.
IF PSBSCHT="O"
Begin DoDot:2
+29 IF $DATA(^PSB(53.79,"AORD",DFN,PSBONX))
SET PSBOKAY="-1^Already Given"
SET PSBCNT=2
+30 IF '$TEST
SET PSBOKAY="0^Okay to administer"
End DoDot:2
QUIT
+31 SET PSBOKAY="0^Okay to administer"
End DoDot:1
SET RESULTS(0)=PSBOKAY
QUIT
+32 ; Validate a Continuous Order
+33 if PSBSCHT="C"
Begin DoDot:1
+34 SET (PSBGVN,X,Y)=""
+35 IF PSBOSTS'="A"&(PSBOSTS'="R")
SET PSBOKAY="-1^Order Not Active"
SET PSBCNT=2
QUIT
+36 IF PSBNGF
SET PSBOKAY="-1^marked DO NOT GIVE"
SET PSBCNT=2
QUIT
+37 IF $DATA(^PSB(53.79,"AORD",DFN,PSBIEN_PSBTYPE,PSBADMIN))
Begin DoDot:2
+38 SET X=$ORDER(^PSB(53.79,"AORD",DFN,PSBIEN_PSBTYPE,PSBADMIN,X))
if 'X
QUIT
+39 SET X=$SELECT($PIECE($GET(^PSB(53.79,+X,0)),U,9)="G":1,1:0)
if 'X
QUIT
+40 SET PSBOKAY="-1^Dose already on medication log"
SET PSBCNT=2
End DoDot:2
if X
QUIT
+41 ; Minutes before
+42 SET PSBWIN1=$$GET^XPAR("DIV","PSB ADMIN BEFORE")*-1
+43 ; Minutes After
+44 SET PSBWIN2=$$GET^XPAR("DIV","PSB ADMIN AFTER")
+45 DO NOW^%DTC
SET PSBMIN=$$DIFF^PSBUTL(PSBADMIN,%)
+46 ; PENDING A PC SOLUTION!
+47 IF PSBMIN<PSBWIN1
SET PSBOKAY="1^Admin is "_(PSBMIN*-1)_" minutes before the scheduled administration time"
QUIT
+48 IF PSBMIN>PSBWIN2
SET PSBOKAY="1^Admin is "_(PSBMIN)_" minutes after the scheduled administration time"
QUIT
+49 SET PSBOKAY="0^Okay to administer"
End DoDot:1
+50 ; Validate a PRN Order
+51 if PSBSCHT="P"
Begin DoDot:1
+52 IF PSBOSTS'="A"&(PSBOSTS'="R")
SET PSBOKAY="-1^Order Not Active"
SET PSBCNT=2
QUIT
+53 IF PSBNGF
SET PSBOKAY="-1^marked DO NOT GIVE"
SET PSBCNT=2
QUIT
+54 ; CHECK Q4H STUFF SEND 1^TO SOON IF TOO SOON.
+55 SET PSBOKAY="1^Brief Administration History"
+56 ; Get Last Four Givens
+57 SET PSBDT=""
+58 FOR
SET PSBDT=$ORDER(^PSB(53.79,"AOIP",DFN,PSBOIT,PSBDT),-1)
if PSBDT=""
QUIT
Begin DoDot:2
+59 SET PSBDA=""
+60 FOR
SET PSBDA=$ORDER(^PSB(53.79,"AOIP",DFN,PSBOIT,PSBDT,PSBDA),-1)
if 'PSBDA
QUIT
Begin DoDot:3
+61 if $PIECE(^PSB(53.79,PSBDA,0),U,9)="N"
QUIT
+62 SET X=$$GET1^DIQ(53.79,PSBDA_",",.06)_" "
+63 SET X=X_$$GET1^DIQ(53.79,PSBDA_",",.09)_" "
+64 SET X=X_$$GET1^DIQ(53.79,PSBDA_",",.12)_" "
+65 SET X=X_$$GET1^DIQ(53.79,PSBDA_",",.21)_" "
+66 SET X=X_$$GET1^DIQ(53.79,PSBDA_",",.16)_" "
+67 SET PSBOKAY($ORDER(PSBOKAY(""),-1)+1)=X
+68 if $DATA(PSBOKAY(4))
SET PSBDT=0
End DoDot:3
End DoDot:2
End DoDot:1
+69 ; Validate a One-Time Order
+70 if PSBSCHT="O"
Begin DoDot:1
+71 SET (PSBGVN,X,Y)=""
+72 FOR
SET X=$ORDER(^PSB(53.79,"AOIP",DFN,PSBOIT,X),-1)
if 'X
QUIT
Begin DoDot:2
+73 FOR
SET Y=$ORDER(^PSB(53.79,"AOIP",DFN,PSBOIT,X,Y),-1)
if 'Y
QUIT
if ($PIECE(^PSB(53.79,Y,.1),U)=PSBONX)&($PIECE(^PSB(53.79,Y,0),U,9)="G")
SET PSBGVN=1
SET (X,Y)=0
End DoDot:2
+74 IF PSBGVN
SET PSBOKAY="-1^Dose Already on medication Log"
SET PSBCNT=2
QUIT
+75 ; One Time are automatically expired so we don't check STATUS here
+76 IF PSBNGF
SET PSBOKAY="-1^marked DO NOT GIVE"
SET PSBCNT=2
QUIT
+77 SET PSBOKAY="0^Okay to administer"
End DoDot:1
+78 ; Validate an On Call Order
+79 if PSBSCHT="OC"
Begin DoDot:1
+80 SET PSBOKAY="0^Okay to administer"
SET (PSBGVN,X,Y)=""
+81 FOR
SET X=$ORDER(^PSB(53.79,"AOIP",DFN,PSBOIT,X),-1)
if 'X
QUIT
Begin DoDot:2
+82 FOR
SET Y=$ORDER(^PSB(53.79,"AOIP",DFN,PSBOIT,X,Y),-1)
if 'Y
QUIT
if $PIECE(^PSB(53.79,Y,.1),U)=PSBONX
SET PSBGVN=1
SET (X,Y)=0
End DoDot:2
+83 IF PSBGVN&('$$GET^XPAR("DIV","PSB ADMIN MULTIPLE ONCALL"))
SET PSBOKAY="-1^Dose Already on medication Log"
SET PSBCNT=2
QUIT
+84 IF PSBOSTS'="A"&(PSBOSTS'="R")
SET PSBOKAY="-1^Order Not Active"
SET PSBCNT=2
QUIT
+85 IF PSBNGF
SET PSBOKAY="-1^marked DO NOT GIVE"
SET PSBCNT=2
QUIT
+86 SET PSBOKAY="0^Okay to administer"
End DoDot:1
+87 ;
+88 if +PSBOKAY'=-1
Begin DoDot:1
+89 NEW PSBDIFF,Y,X,PSBSTUS
+90 ; Ok, now we know it is on-call or cont and not on the log.
+91 if (PSBSCHT="C")!(PSBSCHT="OC"&('$GET(PSBGVN)))
Begin DoDot:2
+92 SET Y=$ORDER(^PSB(53.79,"AOIP",DFN,PSBOIT,""),-1)
+93 SET PSBDIFF=$$FMDIFF^XLFDT($$NOW^XLFDT(),Y,2)
+94 ; Greater than 2 hours
if PSBDIFF>7200
QUIT
+95 ;Check for the status of the medication and insert status in the text
+96 IF Y]""
SET X=$ORDER(^PSB(53.79,"AOIP",DFN,PSBOIT,Y,""),-1)
SET PSBSTUS=$PIECE(^PSB(53.79,X,0),U,9)
+97 SET PSBSTUS=$SELECT(PSBSTUS="G":"GIVEN",PSBSTUS="H":"HELD",1:"REFUSED")
+98 SET Y="*** NOTICE, "_PSBOITX_" was "_PSBSTUS_" "_(PSBDIFF\60)_" minutes ago."
+99 IF +PSBOKAY=1
SET PSBOKAY(1)=Y
+100 IF '$TEST
SET PSBOKAY="1^"_Y
End DoDot:2
End DoDot:1
+101 ;
+102 DO NOW^%DTC
+103 IF PSBSCHT'="O"&(%<($$FMADD^XLFDT(PSBOST,"","",$$GET^XPAR("ALL","PSB ADMIN BEFORE")*-1)))
SET RESULTS(0)="-1^Order Not Active"
IF PSBCNT=0
SET PSBCNT=1
QUIT
+104 ;
+105 SET RESULTS(0)=PSBOKAY
+106 FOR X=1:1
if '$DATA(PSBOKAY(X))
QUIT
SET RESULTS($ORDER(RESULTS(""),-1)+1)=PSBOKAY(X)
+107 QUIT
+108 ;
