source: FOIAVistA/trunk/r/BAR_CODE_MED_ADMIN-ALPB-PSB/PSBMLTS.m@ 1119

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

initial load of FOIAVistA 6/30/08 version

File size: 4.8 KB
Line 
1PSBMLTS ;BIRMINGHAM/EFC-BCMA MEDICATION LOG FUNCTIONS ;Mar 2004
2 ;;3.0;BAR CODE MED ADMIN;;Mar 2004
3 ;
4 ; Reference/IA
5 ; EN^PSJBCMA/2828
6 ; EN^PSJBCMA1/2829
7 ; File 50/221
8 ;
9EN ;
10 N DFN,PSBCNT,PSBDT,PSBERR,PSBMED,PSBNOW,PSBSCHD,PSBVDT
11 K ^TMP("PSB",$J),^TMP("PSJ",$J),PSBORD,PSBREC
12 W @IOF,!,"Manual Medication Log Trouble Shooter",!!
13 S DIC="^DPT(",DIC(0)="AEQM",DIC("A")="Select PATIENT: "
14 D ^DIC K DIC Q:+Y<1 S DFN=+Y
15 K DIR S DIR(0)="DO^",DIR("A")="Select Date To Validate"
16 D ^DIR Q:+Y<1
17 S PSBVDT=+Y
18 W !,"Searching for Orders..."
19 K ^TMP("PSJ",$J)
20 D EN^PSJBCMA(DFN,PSBVDT,"")
21 Q:$G(^TMP("PSJ",$J,1,0))=-1
22 S PSBERR=0
23 D NOW^%DTC S PSBNOW=%
24 F PSBX=0:0 S PSBX=$O(^TMP("PSJ",$J,PSBX)) Q:'PSBX D
25 .Q:$P(^TMP("PSJ",$J,PSBX,0),U,3)?.N1"P" ; No Pending Yet
26 .K PSBORD,^TMP("PSBTMP",$J)
27 .M PSBORD=^TMP("PSJ",$J,PSBX)
28 .S PSBSCHD=$P(PSBORD(1),U,2)
29 .I PSBSCHD="" D Q
30 .I PSBSCHD="C"&($P(PSBORD(1),U,6)="") D Q
31 ..W !!,"Notice: Order #",+$P(PSBORD(0),U,3)
32 ..W $S($P(PSBORD(0),U,3)?.N1"U":" (UNIT DOSE) ",$P(PSBORD(0),U,3)?.N1"V":" (IV) ",1:"")
33 ..W " doesn't have administration times"
34 .S ^TMP("PSB",$J,PSBSCHD,$P(PSBORD(3),U,2),PSBX)=$P(PSBORD(0),U,3)_U_$P(PSBORD(1),U,6)
35 D EN1 G EN
36 ;
37EN1 ;
38 W $$HDR() I '$D(^TMP("PSB",$J)) W !!?5,"No Med Orders Found!",! Q
39 S PSBSCHD="",PSBCNT=0
40 F S PSBSCHD=$O(^TMP("PSB",$J,PSBSCHD)) Q:PSBSCHD="" D
41 .W ! ; Line between order types
42 .S PSBMED=""
43 .F S PSBMED=$O(^TMP("PSB",$J,PSBSCHD,PSBMED)) Q:PSBMED="" D
44 ..F PSBX=0:0 S PSBX=$O(^TMP("PSB",$J,PSBSCHD,PSBMED,PSBX)) Q:'PSBX D
45 ...I $Y>(IOSL-6) W ! K DIR S DIR(0)="E" D ^DIR W:Y $$HDR() I 'Y S PSBSCHD="Z" Q
46 ...S PSBCNT=PSBCNT+1
47 ...W !,$J(PSBCNT,2),". ",PSBSCHD,?8,PSBMED
48 ...W ?40,$P(^TMP("PSB",$J,PSBSCHD,PSBMED,PSBX),U,1),?50,$P(^(PSBX),U,2)
49 ...S ^TMP("PSBTMP",$J,PSBCNT)=$P(^TMP("PSB",$J,PSBSCHD,PSBMED,PSBX),U,1)
50 F Q:$Y>(IOSL-5) W !
51 K DIR S DIR(0)="NO^1:"_PSBCNT_":0" D ^DIR
52 I Y S Y=^TMP("PSBTMP",$J,Y) D NEW(Y) K ^TMP("PSBTMP",$J) G EN1
53 Q
54 ;
55NEW(Y) ; Create the new entry
56 N PSBREC
57 K ^TMP("PSJ",$J),RESULTS
58 W @IOF D EN^PSJBCMA1(DFN,Y)
59 K PSBORD M PSBORD=^TMP("PSJ",$J)
60 W !,"Order: ",$P(PSBORD(0),U,3)
61 W !,"Medication: ",$P(PSBORD(2),U,2)
62 W !,"Dosage: ",$P(PSBORD(2),U,3)
63 W !,"Schedule: ",$P(PSBORD(4),U,2)
64 W !,"Admin Times: ",$P(PSBORD(4),U,9)
65 W !,"Start D/T: "
66 W !,"Stop D/T: "
67 W !!,"Is this the correct Order" S %=1 D YN^DICN Q:%'=1
68 ;
69 ; PRN, One-Time, On Call orders
70 ;
71 I $P(PSBORD(4),U,1)'="C" D
72 .W ! S %DT="AEQR",%DT("A")="Enter the DATE/TIME of Administration: "
73 .S %DT("B")="Now" D ^%DT Q:Y<1 S PSBDT=Y D D^DIQ
74 .D FILE
75 ;
76 ; Continuous Meds
77 ;
78 I $P(PSBORD(4),U,1)="C" D
79 .W ! S %DT="AEQ",%DT("A")="Enter the DATE of Administration: "
80 .S %DT("B")="Today" D ^%DT Q:Y<1 S PSBDT=Y D D^DIQ
81 .S X="",Y=$P(PSBORD(4),U,9)
82 .F Z=1:1:$L(Y,"-") D
83 ..S X=X_$S(X]"":";",1:"")_Z_":"_$P(Y,"-",Z)
84 .K DIR S DIR(0)="S^"_X,DIR("A")="Select Administration Time"
85 .D ^DIR Q:Y<1
86 .S PSBDT=+(PSBDT_"."_Y(0))
87 .S Y=PSBDT D D^DIQ
88 .D FILE
89 Q
90 ;
91FILE ; Call the med log RPC to validate and order
92 I $D(^PSB(53.79,"AORD",DFN,$P(PSBORD(0),U,3),PSBDT)) W !,"-1^Medication is already logged!"
93 E D VAL^PSBMLVAL(.RESULTS,DFN,+$P(PSBORD(0),U,3),$E($P(PSBORD(0),U,3),$L($P(PSBORD(0),U,3))),PSBDT) S X="" F S X=$O(RESULTS(X)) Q:X="" W !,RESULTS(X)
94 K DIR S DIR(0)="E" D ^DIR
95 Q
96 ;
97HDR() ;
98 W @IOF,"Medication Log Trouble Shooter",!," # "
99 W !,$TR($J("",IOM)," ","-")
100 Q ""
101 ;
102SCANNER ; This checks the scanning mechanism
103 N PSBVAL,PSBSCAN,PSBX,PSBFLD
104 W ! K DIR
105 S DIR(0)="FO^1:45",DIR("A")="Scan Medication" D ^DIR Q:Y["^"!(Y="")
106 S PSBVAL=X K DIR
107 W !!,"Performing 'Exact Matches' scan of Drug File..."
108 K PSBSCAN D SMED(.PSBSCAN,X)
109 W !!,"Results of Scan:"
110 W $S(+PSBSCAN(0)>0:" Good",1:" Invalid")," scan value."
111 S X="" F S X=$O(PSBSCAN(X)) Q:X="" W !!?5,PSBSCAN(X)
112 G:+PSBSCAN(0)>0 SCANNER
113 W !!,"Performing 'Non-Exact Match' scan on the Drug File...",!
114 K ^TMP("DILIST",$J)
115 ;
116 D FIND^DIC(50,"","","AX",PSBVAL,"*","B^C")
117 ;
118 I +$G(^TMP("DILIST",$J,0))<1 W !!,"Nothing found in drug file matching '",PSBVAL,"'." G SCANNER
119 W !,"There are ",+^TMP("DILIST",$J,0)," matches to '",PSBVAL,"'."
120 F PSBX=0:0 S PSBX=$O(^TMP("DILIST",$J,2,PSBX)) Q:'PSBX D
121 .W !!,"MATCH #:..................",PSBX
122 .W !,"IEN:......................",^TMP("DILIST",$J,2,PSBX)
123 .W !,"NAME:.....................",^TMP("DILIST",$J,1,PSBX)
124 .S PSBFLD=0
125 .F S PSBFLD=$O(^TMP("DILIST",$J,"ID",PSBX,PSBFLD)) Q:'PSBFLD D
126 ..D FIELD^DID(50,PSBFLD,"","LABEL","PSBFLD")
127 ..W !,PSBFLD("LABEL"),":" F Q:$X>25 W "."
128 ..W ^TMP("DILIST",$J,"ID",PSBX,PSBFLD)
129 K ^TMP("DILIST",$J)
130 Q
131 ;
132SMED(RESULTS,PSBDATA) ; Lookup Medication
133 I $$GET^XPAR("DIV","PSB ROBOT RX"),PSBDATA?1"3"15N!(PSBDATA?1"3"17N),123[$E(PSBDATA,12) S PSBDATA=$E(PSBDATA,2,11)
134 S X=$$FIND1^DIC(50,"","AX",PSBDATA,"B^C")
135 I X<1 S RESULTS(0)="-1^Invalid Medication Lookup"
136 E S RESULTS(0)=X_U_$$GET1^DIQ(50,X_",",.01)
137 Q
Note: See TracBrowser for help on using the repository browser.