source: FOIAVistA/trunk/r/OUTPATIENT_PHARMACY-PSO-APSP-HUIP/PSOBKDED.m@ 1274

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

initial load of FOIAVistA 6/30/08 version

File size: 9.3 KB
Line 
1PSOBKDED ;BIR/SAB - Edit backdoor Rx Order entry ;04/17/95
2 ;;7.0;OUTPATIENT PHARMACY;**11,46,91,78,99,117,133,143,268**;DEC 1997;Build 9
3 ;Ref PS(50.607 IA 2221
4 ;Ref PS(50.7 IA 2223
5 ;Ref PS(51.2 IA 2226
6 ;Ref PSDRUG( IA 221
7 ;Ref DOSE^PSSORPH IA 3234
8 ;Ref PS(55 IA 2228
91 S %DT="AEX",%DT(0)=-PSONEW("FILL DATE"),Y=PSONEW("ISSUE DATE") X ^DD("DD") S %DT("A")="ISSUE DATE: ",%DT("B")=Y D ^%DT
10 I "^"[$E(X) D KX K %DT Q
11 G:Y=-1 1 S (PSOID,PSONEW("ISSUE DATE"))=Y D KX K %DT
12 Q
132 S PSONEW("FLD")=2 D FILLDT^PSODIR2(.PSONEW) ;Fdt
14 Q
153 S:$G(POERR) PSONEW("ISSUE DATE")=PSOID
16 S PSONEW("FLD")=3 D PTSTAT^PSODIR1(.PSONEW) ;Sta
17 Q
184 S PSONEW("FLD")=4 D PROV^PSODIR(.PSONEW) ;Pro
19 Q
205 S PSONEW("FLD")=5 D CLINIC^PSODIR2(.PSONEW) ;Cli
21 Q
226 S PSONEW("FLD")=6 D ^PSODRG,EN^PSODIAG ;Drg/ICD
23 D 6^PSODRGN
24 Q
257 S PSONEW("FLD")=7 D QTY^PSODIR1(.PSONEW) ;Qty
26 Q
278 S PSONEW("FLD")=8 D DAYS^PSODIR1(.PSONEW) ;Day
28 K PSMAX,PSTMAX D REF^PSOORNEW S PSONEW("N# REF")=PSONEW("# OF REFILLS")
29 Q
309 S PSONEW("FLD")=9 D REFILL^PSODIR1(.PSONEW) ;Ref
31 K PSMAX,PSTMAX
32 Q
3310 S PSONEW("FLD")="3A" D DOSE^PSODIR(.PSONEW) ;Dose
34 Q
35 ;
36 Q I $G(COPY),$G(SIGOK) S PSOFDR=1 K PSONEW("SIG")
37 S PSONEW("FLD")=10 D SIG^PSODIR1(.PSONEW) ;Sig
38 I $G(COPY) K PSOFDR
39 S DIR(0)="E",DIR("A")="Press Return to Continue" D ^DIR D KV
40 Q
41INS S PSONEW("FLD")="3B" D INS^PSODIR(.PSONEW) ;Ins
42 Q
4311 S PSONEW("FLD")=11 D COPIES^PSODIR1(.PSONEW) ;Cop
44 Q
4512 S PSONEW("FLD")=12 D MW^PSODIR2(.PSONEW) ;M/W
46 Q
4713 S PSONEW("FLD")=13 D RMK^PSODIR2(.PSONEW) ;Rem
48 Q
49DOSE ;backdoor
50 I '$G(PSONEW("ENT")) S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" (5) Dosage Ordered: " G INS1
51 S SD=1 F I=1:1:PSONEW("ENT") D
52 .I '$G(PSONEW("DOSE ORDERED",I)),$G(PSONEW("VERB",I))]"" S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" Verb: "_$G(PSONEW("VERB",I))
53 .S:$G(SD)=1 IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" (5)",DS=1 K SD
54 .D DOSE1
55INS1 S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" (6)Pat Instruction:"
56INS2 I $O(PSONEW("SIG",0)) F D=0:0 S D=$O(PSONEW("SIG",D)) Q:'D D
57 .F SG=1:1:$L(PSONEW("SIG",D)) S:$L(^TMP("PSOPO",$J,IEN,0)_" "_$P(PSONEW("SIG",D)," ",SG))>80 IEN=IEN+1,$P(^TMP("PSOPO",$J,IEN,0)," ",21)=" " D
58 ..S:$P(PSONEW("SIG",D)," ",SG)'="" ^TMP("PSOPO",$J,IEN,0)=$G(^TMP("PSOPO",$J,IEN,0))_" "_$P(PSONEW("SIG",D)," ",SG)
59 I $P($G(^PS(55,PSODFN,"LAN")),"^") D Q
60 .S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" Other Patient Inst.: "
61 .I $G(^PSRX(+$G(PSONEW("OIRXN")),"INSS"))]"" S PSONEW("SINS")=^PSRX(PSONEW("OIRXN"),"INSS")
62 .S ^TMP("PSOPO",$J,IEN,0)=^TMP("PSOPO",$J,IEN,0)_$G(PSONEW("SINS"))
63 Q
64 ;
65DOSE1 I $G(DS)=1 D K DS G DU
66 .S ^TMP("PSOPO",$J,IEN,0)=^TMP("PSOPO",$J,IEN,0)_" Dosage Ordered: "_$S($E(PSONEW("DOSE",I),1)="."&($G(PSONEW("DOSE ORDERED",I))):"0",1:"")_PSONEW("DOSE",I)_$S($G(PSONEW("UNITS",I))'="":" ("_$P(^PS(50.607,PSONEW("UNITS",I),0),"^")_")",1:"")
67 S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" Dosage Ordered: "_$S($E(PSONEW("DOSE",I),1)="."&($G(PSONEW("DOSE ORDERED",I))):"0",1:"")_PSONEW("DOSE",I)_$S($G(PSONEW("UNITS",I))'="":" ("_$P(^PS(50.607,PSONEW("UNITS",I),0),"^")_")",1:"")
68DU I '$G(PSONEW("DOSE ORDERED",I)),$P($G(^PS(55,PSODFN,"LAN")),"^") S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" Oth. Lang. Dosage: "_$G(PSONEW("ODOSE",I))
69 I $G(PSONEW("DOSE ORDERED",I)),$G(PSONEW("VERB",I))]"" S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" Verb: "_$G(PSONEW("VERB",I))
70 S:$G(PSONEW("DOSE ORDERED",I)) IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" Dispense Units: "_$S($E($G(PSONEW("DOSE ORDERED",I)),1)=".":"0",1:"")_$G(PSONEW("DOSE ORDERED",I))
71 I $G(PSONEW("DOSE ORDERED",I)),$G(PSONEW("NOUN",I))]"" S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" Noun: "_PSONEW("NOUN",I)
72 I $G(PSONEW("ROUTE",I)) S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" Route: "_$P(^PS(51.2,PSONEW("ROUTE",I),0),"^")
73 S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" Schedule: "_PSONEW("SCHEDULE",I)
74 I $G(PSONEW("DURATION",I))]"" D
75 .S IEN=IEN+1
76 .S ^TMP("PSOPO",$J,IEN,0)=" *Duration: "_PSONEW("DURATION",I)_" ("_$S(PSONEW("DURATION",I)["M":"MINUTES",PSONEW("DURATION",I)["W":"WEEKS",PSONEW("DURATION",I)["L":"MONTHS",PSONEW("DURATION",I)["H":"HOURS",1:"DAYS")_")"
77 I $G(PSONEW("CONJUNCTION",I))]"" S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" Conjunction: "_$S($G(PSONEW("CONJUNCTION",I))="A":"AND",$G(PSONEW("CONJUNCTION",I))="T":"THEN",$G(PSONEW("CONJUNCTION",I))="X":"EXCEPT",1:"")
78 Q
79RTE I $G(DRET) S PSORXED("ROUTE",ENT)=""
80 I $G(RTE) K RTE
81 K DIR,DIRUT S DIR(0)="FO^2:45",DIR("A")="ROUTE",DIR("?")="^D HLP^PSOORED4"
82 S DIR("B")=$S($G(PSORXED("ROUTE",ENT)):$P(^PS(51.2,PSORXED("ROUTE",ENT),0),"^"),$G(RTE)]"":RTE,$G(DRET):"",1:"PO") K:DIR("B")="" DIR("B")
83 ;I '$G(PSORXED("ROUTE",ENT)),$G(PSOREEDT) K DIR("B")
84 D ^DIR I X[U,$L(X)>1 S FIELD="RTE",JUMP=1 K DIRUT,DTOUT Q
85 Q:$D(DTOUT)!($D(DUOUT))
86 I X="@"!(X="") K RTE,ERTE S DRET=1,PSORXED("ROUTE",ENT)="" Q
87 K DRET I X=$P($G(^PS(51.2,+$G(PSORXED("ROUTE",ENT)),0)),"^") S RTE=$P(^PS(51.2,PSORXED("ROUTE",ENT),0),"^") W X_" "_$G(ERTE) Q
88 S DIC=51.2,DIC(0)="QEZM",DIC("S")="I $P(^(0),""^"",4)" D ^DIC Q:X[U G:Y=-1 RTE W " "_$P(Y(0),"^",2)
89 S:X'="" PSORXED("ROUTE",ENT)=+Y,RTE=Y(0,0),ERTE=$P(Y(0),"^",2)
90 Q
91ASK K JUMP,UNITN,DOSE D KV D DOSE^PSSORPH(.DOSE,PSODRUG("IEN"),"O",PSODFN)
92 I $D(DOSE("DD")) I $G(PSOFROM)="PENDING"!($G(PSOREEDQ)) D LST2^PSOBKDE1 G ASK1
93 D:$G(PSOFROM)="NEW"&($G(PSORX("EDIT"))']"")!($G(PSOFROM1))!($G(COPY)) LST^PSOBKDE1:$O(DOSE(0))
94ASK1 S STRE=$P($G(DOSE("DD",PSODRUG("IEN"))),"^",5),UNITN=$P($G(DOSE("DD",PSODRUG("IEN"))),"^",6),DOSE("LD")=$P($G(DOSE("DD",PSODRUG("IEN"))),"^",11)
95 W ! S DIR(0)="F^1:60",DIR("A",1)="Select from list of Available Dosages, Enter Free Text Dose",DIR("?")="^D LST1^PSOBKDE1",DIR("A")="or Enter a Question Mark (?) to view list"
96 I $G(PSORXED("DOSE",ENT))]"" S DIR("B")=PSORXED("DOSE",ENT) D
97 .I $G(PSORXED("UNITS",ENT))]"",DIR("B")'[($P($G(^PS(50.607,PSORXED("UNITS",ENT),0)),"^")) S DIR("B")=DIR("B")_$P($G(^PS(50.607,PSORXED("UNITS",ENT),0)),"^")
98 K:$G(PSOREEDQ)!($G(PSOBDRG)) DIR("B")
99 D ^DIR
100 I X[U,$L(X)>1 S FIELD="ASK",JUMP=1 K DIRUT,DTOUT Q
101 I $D(DIRUT) S:$G(ORD) PSODSPL=1 Q
102 I X=$G(PSORXED("DOSE",ENT)),$D(DOSE(Y)) G GD1
103 I X=$G(PSORXED("DOSE",ENT)) D G DOS
104 .S DOSE=X,UNITS=$G(PSORXED("UNITS",ENT))
105 .I DOSE'?.N&(DOSE'?.N1".".N)!'DOSE("LD") S (UNITN,UNITS,PSORXED("UNITS",ENT))="" K PSORXED("DOSE ORDERED",ENT),DUPD,PSORXED("NOUN",ENT)
106GD1 N PSORXTE
107 I $D(DOSE(Y)) D G DOS ;from list
108 .S DOSE=$S($P(DOSE(Y),"^"):$P(DOSE(Y),"^"),$P(DOSE(Y),"^",3)]"":$P(DOSE(Y),"^",3),1:1),DOLST=Y
109 .I $P(DOSE(Y),"^") S UNITS=$P(DOSE(Y),"^",2),DUPD=$P(DOSE(Y),"^",3),UNITN=$P(DOSE("DD",PSODRUG("IEN")),"^",6),PSORXTE("DOSE ORDERED",ENT)=DUPD
110 .S PSORXTE("NOUN",ENT)=$P(DOSE(Y),"^",6),PSORXTE("VERB",ENT)=$P(DOSE(Y),"^",8)
111 .I DOSE'?.N&(DOSE'?.N1".".N)!'DOSE("LD") D Q
112 ..S (UNITN,UNITS,PSORXED("UNITS",ENT))="" K PSORXED("DOSE ORDERED",ENT),DUPD,PSORXED("NOUN",ENT)
113 ..I $P($G(^PS(55,PSODFN,"LAN")),"^"),$G(PSOFROM)="PENDING" D LAN^PSOORED5 Q
114 ..I $P($G(^PS(55,PSODFN,"LAN")),"^"),$G(PSOFROM)="NEW" D LAN^PSOORED5
115 .S PSORXTE("UNITS",ENT)=$G(UNITS)
116 S DOSE=Y,DOLST=0 ;non-numeric and numeric not in list
117 I DOSE("LD") D
118 .F I=1:1:$L(DOSE) I $E(DOSE,I)'?.N&($E(DOSE,I)'?1" ")&($E(DOSE,I)'?1".") S DCHK=$G(DCHK)_$E(DOSE,I)
119 .I $G(DCHK)]"" D
120 ..S DCHK=$TR(DCHK,"qwertyuioplkjhgfdsazxcvbnm","QWERTYUIOPLKJHGFDSAZXCVBNM")
121 ..I DCHK=UNITN S DOSE=+DOSE
122 K I,DCHK
123 S PSOINDT=$$GET1^DIQ(50,PSODRUG("IEN"),100,"I") I PSOINDT,DT>PSOINDT G DOS
124 S PSORXTE("NOUN",ENT)=$P(DOSE("DD",PSODRUG("IEN")),"^",9),PSORXTE("VERB",ENT)=$P(DOSE("DD",PSODRUG("IEN")),"^",10)
125 I DOSE'?.N&(DOSE'?.N1".".N)!'DOSE("LD") S (UNITN,UNITS,PSORXED("UNITS",ENT))="" K PSORXED("NOUN",ENT),PSORXED("ODOSE",ENT) G DOS
126 S:$P(DOSE("DD",PSODRUG("IEN")),"^",6)]"" (PSORXTE("UNITS",ENT),UNITS)=$O(^PS(50.607,"B",$P(DOSE("DD",PSODRUG("IEN")),"^",6),0)),UNITN=$P(DOSE("DD",PSODRUG("IEN")),"^",6)
127 S:$P(DOSE("DD",PSODRUG("IEN")),"^",5) DUPD=DOSE/$P(DOSE("DD",PSODRUG("IEN")),"^",5),PSORXTE("DOSE ORDERED",ENT)=DUPD
128DOS W " "_$S($E(DOSE,1)="."&($G(UNITN)'=""):"0",1:"")_DOSE W:$G(UNITN)'="" UNITN
129 W ! K DIR,DIRUT S DIR(0)="Y",DIR("A")="You entered "_$S($E(DOSE,1)="."&($G(UNITN)'=""):"0",1:"")_DOSE_$S($G(UNITN)'="":UNITN,1:"")_" is this correct",DIR("B")="Yes"
130 D ^DIR I 'Y D KX K DOSE,UNITS,PSORXTE,PSOINDT G ASK
131 S PSORXED("DOSE",ENT)=DOSE
132 S:$G(PSORXTE("DOSE ORDERED",ENT))]"" PSORXED("DOSE ORDERED",ENT)=PSORXTE("DOSE ORDERED",ENT)
133 S:$G(PSORXTE("NOUN",ENT))]"" PSORXED("NOUN",ENT)=PSORXTE("NOUN",ENT)
134 S:$G(PSORXTE("VERB",ENT))]"" PSORXED("VERB",ENT)=PSORXTE("VERB",ENT)
135 S:$G(PSORXTE("UNITS",ENT))]"" PSORXED("UNITS",ENT)=PSORXTE("UNITS",ENT)
136 I $G(PSORXED("DOSE",ENT))'?.N&($G(PSORXED("DOSE",ENT))'?.N1".".N)!'DOSE("LD"),$P($G(^PS(55,PSODFN,"LAN")),"^") D
137 .K OTHDOS(ENT) D KX S DIR(0)="52.0113,9"
138 .I '$G(OTHDOS(ENT)),$G(PSORXED("ODOSE",ENT))']"" D LAN^PSOORED5
139 .I $G(PSORXED("ODOSE",ENT))]"" S DIR("B")=PSORXED("ODOSE",ENT) K:DIR("B")="" DIR("B")
140 .K DTOUT,DUOUT,DIRUT,Y,X D ^DIR K DIR K:$G(X)="@"!($G(X)="") DIRUT I $D(DIRUT) Q
141 .I X="@" S OTHDOS(ENT)=1 D KX K PSORXED("ODOSE",ENT) Q
142 .S:X'="" PSORXED("ODOSE",ENT)=X
143 Q
144 ;
145SCH D KX
146 S DIR("?")="^D SCHLP^PSOORED4",DIR("A")="Schedule: ",DIR(0)="FA^1:20^I X[""""""""!(X?.E1C.E)!($A(X)=45)!($L(X,"" "")>3)!($L(X)>20)!($L(X)<1) K X"
147 I '$D(PSOSCH),'$D(PSORXED("SCHEDULE",ENT)),$P(^PS(50.7,PSODRUG("OI"),0),"^",8)]"" S PSOSCH=$P(^PS(50.7,PSODRUG("OI"),0),"^",8)
148 S DIR("B")=$S($D(PSOSCH)&('$D(PSORXED("SCHEDULE",ENT))):PSOSCH,$G(PSORXED("SCHEDULE",ENT))]"":PSORXED("SCHEDULE",ENT),1:"") K:DIR("B")="" DIR("B")
149 I $G(PSORXED("SCHEDULE",ENT))']"",$G(PSOREEDT) K DIR("B")
150 D ^DIR
151 Q
152KX K X,Y
153KV K DTOUT,DUOUT,DIR,DIRUT
154 Q
Note: See TracBrowser for help on using the repository browser.