source: FOIAVistA/tag/r/BAR_CODE_MED_ADMIN-ALPB-PSB/PSBMLVAL.m@ 636

Last change on this file since 636 was 628, checked in by George Lilly, 14 years ago

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