- 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 Feb 18, 2025@23:06:38 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 ;