Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PSBMLVAL

PSBMLVAL.m

Go to the documentation of this file.
  1. PSBMLVAL ;BIRMINGHAM/EFC-BCMA MED LOG VALIDATION ;Mar 2004
  1. ;;3.0;BAR CODE MED ADMIN;**88**;Mar 2004;Build 11
  1. ;Per VA Directive 6402, this routine should not be modified.
  1. ;
  1. ;
  1. VAL(RESULTS,DFN,PSBIEN,PSBTYPE,PSBADMIN) ;
  1. ;
  1. ; RPC: PSB VALIDATE ORDER
  1. ;
  1. ; Description: Final check of order against an actual administration
  1. ; date/time used immediately after scanned med has been
  1. ; validated to be a good unadministered order and by the
  1. ; PSBODL (Due List) output.
  1. ;
  1. ; Variables: DFN: Patient IEN
  1. ; PSBIEN: Order IEN
  1. ; PSBTYPE: U:Unit Dose/V:IV
  1. ; PSBADMIN: Scheduled Administration Time
  1. ;
  1. N PSBOKAY,PSBORD,PSBSCHT,PSBOST,PSBOSP,PSBDT,PSBDA,PSBNOW
  1. ;
  1. K PSBORD
  1. D PSJ1^PSBVT(DFN,PSBIEN_PSBTYPE)
  1. S PSBCNT=0
  1. S PSBOKAY="-1^***Unable to determine administration" ; Default Flag
  1. D NOW^%DTC
  1. ;
  1. ;
  1. I PSBSCHT'="O"&(%>PSBOSP) S RESULTS(0)="-1^Order Not Active",PSBCNT=2 Q
  1. ; Validate an IV
  1. I PSBONX?.N1"V" D S RESULTS(0)=PSBOKAY Q
  1. .I PSBOSTS'="A"&(PSBOSTS'="R")&(PSBOSTS'="O") S PSBOKAY="-1^Order Not Active",PSBCNT=2 Q ;Include On Call Orders, PSB*3*88
  1. .I PSBNGF S PSBOKAY="-1^marked DO NOT GIVE",PSBCNT=2 Q
  1. .I PSBSCHT="O" D Q ; Make sure One Time is not given.
  1. ..I $D(^PSB(53.79,"AORD",DFN,PSBONX)) S PSBOKAY="-1^Already Given",PSBCNT=2
  1. ..E S PSBOKAY="0^Okay to administer"
  1. .S PSBOKAY="0^Okay to administer"
  1. ; Validate a Continuous Order
  1. D:PSBSCHT="C"
  1. .S (PSBGVN,X,Y)=""
  1. .I PSBOSTS'="A"&(PSBOSTS'="R") S PSBOKAY="-1^Order Not Active",PSBCNT=2 Q
  1. .I PSBNGF S PSBOKAY="-1^marked DO NOT GIVE",PSBCNT=2 Q
  1. .I $D(^PSB(53.79,"AORD",DFN,PSBIEN_PSBTYPE,PSBADMIN)) D Q:X
  1. ..S X=$O(^PSB(53.79,"AORD",DFN,PSBIEN_PSBTYPE,PSBADMIN,X)) Q:'X
  1. ..S X=$S($P($G(^PSB(53.79,+X,0)),U,9)="G":1,1:0) Q:'X
  1. ..S PSBOKAY="-1^Dose already on medication log",PSBCNT=2
  1. .; Minutes before
  1. .S PSBWIN1=$$GET^XPAR("DIV","PSB ADMIN BEFORE")*-1
  1. .; Minutes After
  1. .S PSBWIN2=$$GET^XPAR("DIV","PSB ADMIN AFTER")
  1. .D NOW^%DTC S PSBMIN=$$DIFF^PSBUTL(PSBADMIN,%)
  1. .; PENDING A PC SOLUTION!
  1. .I PSBMIN<PSBWIN1 S PSBOKAY="1^Admin is "_(PSBMIN*-1)_" minutes before the scheduled administration time" Q
  1. .I PSBMIN>PSBWIN2 S PSBOKAY="1^Admin is "_(PSBMIN)_" minutes after the scheduled administration time" Q
  1. .S PSBOKAY="0^Okay to administer"
  1. ; Validate a PRN Order
  1. D:PSBSCHT="P"
  1. .I PSBOSTS'="A"&(PSBOSTS'="R") S PSBOKAY="-1^Order Not Active",PSBCNT=2 Q
  1. .I PSBNGF S PSBOKAY="-1^marked DO NOT GIVE",PSBCNT=2 Q
  1. .; CHECK Q4H STUFF SEND 1^TO SOON IF TOO SOON.
  1. .S PSBOKAY="1^Brief Administration History"
  1. .; Get Last Four Givens
  1. .S PSBDT=""
  1. .F S PSBDT=$O(^PSB(53.79,"AOIP",DFN,PSBOIT,PSBDT),-1) Q:PSBDT="" D
  1. ..S PSBDA=""
  1. ..F S PSBDA=$O(^PSB(53.79,"AOIP",DFN,PSBOIT,PSBDT,PSBDA),-1) Q:'PSBDA D
  1. ...Q:$P(^PSB(53.79,PSBDA,0),U,9)="N"
  1. ...S X=$$GET1^DIQ(53.79,PSBDA_",",.06)_" "
  1. ...S X=X_$$GET1^DIQ(53.79,PSBDA_",",.09)_" "
  1. ...S X=X_$$GET1^DIQ(53.79,PSBDA_",",.12)_" "
  1. ...S X=X_$$GET1^DIQ(53.79,PSBDA_",",.21)_" "
  1. ...S X=X_$$GET1^DIQ(53.79,PSBDA_",",.16)_" "
  1. ...S PSBOKAY($O(PSBOKAY(""),-1)+1)=X
  1. ...S:$D(PSBOKAY(4)) PSBDT=0
  1. ; Validate a One-Time Order
  1. D:PSBSCHT="O"
  1. .S (PSBGVN,X,Y)=""
  1. .F S X=$O(^PSB(53.79,"AOIP",DFN,PSBOIT,X),-1) Q:'X D
  1. ..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
  1. .I PSBGVN S PSBOKAY="-1^Dose Already on medication Log",PSBCNT=2 Q
  1. .; One Time are automatically expired so we don't check STATUS here
  1. .I PSBNGF S PSBOKAY="-1^marked DO NOT GIVE",PSBCNT=2 Q
  1. .S PSBOKAY="0^Okay to administer"
  1. ; Validate an On Call Order
  1. D:PSBSCHT="OC"
  1. .S PSBOKAY="0^Okay to administer",(PSBGVN,X,Y)=""
  1. .F S X=$O(^PSB(53.79,"AOIP",DFN,PSBOIT,X),-1) Q:'X D
  1. ..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
  1. .I PSBGVN&('$$GET^XPAR("DIV","PSB ADMIN MULTIPLE ONCALL")) S PSBOKAY="-1^Dose Already on medication Log",PSBCNT=2 Q
  1. .I PSBOSTS'="A"&(PSBOSTS'="R") S PSBOKAY="-1^Order Not Active",PSBCNT=2 Q
  1. .I PSBNGF S PSBOKAY="-1^marked DO NOT GIVE",PSBCNT=2 Q
  1. .S PSBOKAY="0^Okay to administer"
  1. ;
  1. D:+PSBOKAY'=-1
  1. .N PSBDIFF,Y,X,PSBSTUS
  1. .; Ok, now we know it is on-call or cont and not on the log.
  1. .D:(PSBSCHT="C")!(PSBSCHT="OC"&('$G(PSBGVN)))
  1. ..S Y=$O(^PSB(53.79,"AOIP",DFN,PSBOIT,""),-1)
  1. ..S PSBDIFF=$$FMDIFF^XLFDT($$NOW^XLFDT(),Y,2)
  1. ..Q:PSBDIFF>7200 ; Greater than 2 hours
  1. ..;Check for the status of the medication and insert status in the text
  1. ..I Y]"" S X=$O(^PSB(53.79,"AOIP",DFN,PSBOIT,Y,""),-1),PSBSTUS=$P(^PSB(53.79,X,0),U,9)
  1. ..S PSBSTUS=$S(PSBSTUS="G":"GIVEN",PSBSTUS="H":"HELD",1:"REFUSED")
  1. ..S Y="*** NOTICE, "_PSBOITX_" was "_PSBSTUS_" "_(PSBDIFF\60)_" minutes ago."
  1. ..I +PSBOKAY=1 S PSBOKAY(1)=Y
  1. ..E S PSBOKAY="1^"_Y
  1. ;
  1. D NOW^%DTC
  1. 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
  1. ;
  1. S RESULTS(0)=PSBOKAY
  1. F X=1:1 Q:'$D(PSBOKAY(X)) S RESULTS($O(RESULTS(""),-1)+1)=PSBOKAY(X)
  1. Q
  1. ;