source: WorldVistAEHR/trunk/r/VISTA_OFFICE_EHR-VEPE/VEPERXPR.m@ 701

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

initial load of WorldVistAEHR

File size: 8.0 KB
Line 
1VEPERXPR ;DAOU/JLG&MRM - Rx Print ; 4/14/05 9:13am
2 ;;1.0;t1;VO Pharmacy; Mar 25, 2005;Build 1
3 ; -----
4INIT ; Set up variables.
5 S VEPEIO=""
6 N RXNUM,IENS,FIELDS,VEPERX,PROV,PAT,PROVIEN,VEPEPROV,PROVNAM
7 N PATIEN,VEPEPAT,PATNAMN
8CHK ;Check for Rx interactions.
9 S PPL1=1 S:'$G(PPL) PPL=$G(PSORX("PSOL",PPL1))
10 G:$G(PPL)']"" D1
11CHK2 K SPPL G:$D(DTOUT) D1 S SPPL="" F PI=1:1 Q:$P(PPL,",",PI)="" D
12 .S DA=$P(PPL,",",PI)
13 .I $P(^PSRX(DA,"STA"),"^")=4 S SPPL=SPPL_DA_"," Q
14 I $G(SPPL)]"" D
15 .W !!,$C(7),"Drug Interaction Rx(s) "
16 .F I=1:1 Q:$P(SPPL,",",I)="" W $P(^PSRX($P(SPPL,",",I),0),"^")_", "
17 .S PPL=SPPL,DG=1 D Q1 K DG,SPPL
18D1 K RXLTOP
19 I $G(PPL1),$O(PSORX("PSOL",$G(PPL1))) S PPL1=$O(PSORX("PSOL",PPL1)),PPL=PSORX("PSOL",PPL1) G GETINFO
20 I $G(PPL1),$O(PSORX("PSOL",$G(PPL1))) D Q G GETINFO
21 .S PPL1=$O(PSORX("PSOL",PPL1)),PPL=PSORX("PSOL",PPL1)
22Q1 S PPL1=1 G:$G(PPL)']"" D1 S PSNP=0,PSL=1
23 D I $G(PSOFROM)="NEW",$P(PSOPAR,"^",8) S PSNP=1
24 .Q:'$P(PSOPAR,"^",8)!($G(PSONOPRT))
25 .F SLPPL=0:0 S SLPPL=$O(RXRS(SLPPL)) Q:'SLPPL!($G(PSNP)) I '$O(^PSRX(SLPPL,1,0)),'$D(RXPR(SLPPL)) S PSNP=1
26 ;
27 ;Apparently the subscripts of RXFL contain the Rx numbers
28GETINFO S RXNUM=0
29 F S RXNUM=$O(RXFL(RXNUM)) Q:RXNUM="" D
30 . D RX,PROV,INST,PAT,PRINT
31 . K RXFL(RXNUM)
32 . S:'$D(RXNUM)&$D(RXIEN) RXNUM=+RXIEN
33 D EXIT
34 Q
35RX S RXIEN=RXNUM
36 S FIELDS="1;2;4;6;7;9;10.1;26"
37 ;Fields are patient,provider,drug,QTY,#refills,Sig1
38 D GETS^DIQ(52,RXIEN,FIELDS,"R","VEPERX")
39 S Y=$$GET1^DIQ(52,RXIEN,39.1,"","RXARY")
40 S RXIEN=RXIEN_","
41 S PAT=VEPERX(52,RXIEN,"PATIENT"),PROV=VEPERX(52,RXIEN,"PROVIDER")
42 S DRUG=VEPERX(52,RXIEN,"DRUG"),QTY=VEPERX(52,RXIEN,"QTY")
43 S RFL=VEPERX(52,RXIEN,"# OF REFILLS")
44 S SIGN=$S(VEPERX(52,RXIEN,"OERR SIG")="YES":1,1:0)
45 Q
46PROV ;Get provider information
47 D FIND^DIC(200,"","","",PROV,"","B","","","VEPEPROV")
48 S PROVIEN=VEPEPROV("DILIST",2,1)
49 ;ADDRESS, CITY, STATE, ZIP, PHONE, TITLE, DEA #, ELECTRONIC SIG
50 K VEPEPROV
51 S FIELDS=".01;.132;8;53.2;16*;70"
52 D GETS^DIQ(200,PROVIEN,FIELDS,"R","VEPEPROV")
53 S PROVNAM=$P(PROV,",",2)_" "_$P(PROV,",",1),PROVIEN=PROVIEN_","
54 S DEA=VEPEPROV(200,PROVIEN,"DEA#"),PHONE=VEPEPROV(200,PROVIEN,"OFFICE PHONE")
55 S TITLE=VEPEPROV(200,PROVIEN,"TITLE"),N=""
56 F S N=$O(VEPEPROV(200.02,N)) Q:N="" S:'$D(INST) INST=VEPEPROV(200.02,N,"DIVISION") S:VEPEPROV(200.02,N,"DEFAULT")="Yes" INST=VEPEPROV(200.02,N,"DIVISION")
57 Q
58INST ;Get institute information
59 D FIND^DIC(4,"","","",INST,"","B","","","VEPEINST")
60 S INSTIEN=VEPEINST("DILIST",2,1)
61 K VEPEINST
62 S FIELDS="1.01;1.02;1.03;1.04;4.04"
63 D GETS^DIQ(4,INSTIEN,FIELDS,"R","VEPEINST")
64 S INSTIEN=INSTIEN_","
65 S PROVCITY=VEPEINST(4,INSTIEN,"CITY"),PROVCITY=PROVCITY_", "_VEPEINST(4,INSTIEN,"STATE (MAILING)")
66 S PROVCITY=PROVCITY_" "_VEPEINST(4,INSTIEN,"ZIP")
67 S:$D(VEPEINST(4,INSTIEN,"STREET ADDR. 1")) PROVADD=VEPEINST(4,INSTIEN,"STREET ADDR. 1")
68 S:$D(VEPEINST(4,INSTIEN,"STREET ADDR. 2")) PROVADD=PROVADD_" "_VEPEINST(4,INSTIEN,"STREET ADDR. 2")
69 Q
70PAT ;Get patient information
71 D FIND^DIC(2,"","","",PAT,"","B","","","VEPEPAT")
72 S PATIEN=VEPEPAT("DILIST",2,1)
73 ;AGE,ADDRESS
74 S FIELDS=".033;.111;.112;.113;.114;.115;.116"
75 D GETS^DIQ(2,PATIEN,FIELDS,"R","VEPEPAT")
76 S PATNAM=$P(PAT,",",2)_" "_$P(PAT,",",1),PATIEN=PATIEN_","
77 S AGE=VEPEPAT(2,PATIEN,"AGE")
78 S PATADD1=VEPEPAT(2,PATIEN,"STREET ADDRESS [LINE 1]")
79 S PATADD2=VEPEPAT(2,PATIEN,"STREET ADDRESS [LINE 2]")
80 S PATADD3=VEPEPAT(2,PATIEN,"STREET ADDRESS [LINE 3]")
81 S PATADD=$S($D(PATADD1):PATADD1,1:"")_$S($D(PATADD2):PATADD2,1:"")
82 S PATADD=PATADD_$S($D(PATADD3):PATADD3,1:"")
83 S PATCITY=VEPEPAT(2,PATIEN,"CITY")_", "_VEPEPAT(2,PATIEN,"STATE")
84 S PATCITY=PATCITY_VEPEPAT(2,PATIEN,"ZIP CODE")
85 Q
86PRINT ;Print prescription
87 D:PSOPRDEV="F" FAX D:PSOPRDEV="P" PRINTER D:PSOPRDEV="E" EDI
88 Q:PSOPRDEV="E"
89 Q:POP
90 S %DT="T",X="N" D ^%DT S $P(^PSRX(52,92001),U,1)=+Y
91 S $P(^PSRX(52,92001),U,2)=PSOPRDEV
92 G:'Y EXIT
93 U IO
94PRINT2 W !,PROVNAM W:$D(TITLE) ", "_TITLE
95 W:$D(PROVADD) !,PROVADD
96 W !,PROVCITY
97 W:$D(PHONE) !,PHONE_" "
98 W:'$D(PHONE) ! W "DEA #:"_DEA
99 W !,"__________________________________________________"
100 W !,$$FMTE^XLFDT(DT,1)
101 W !,PATNAM_" AGE: "_AGE
102 W !,PATADD,PATCITY
103 W !!," Rx ",!
104 W !," "_DRUG
105 W !," QTY: "_QTY
106 I $D(RXARY) S N="" F S N=$O(RXARY(N)) Q:N="" W !,RXARY(N)
107 W !!!
108 W !,"Signature: ____________________________________"
109 W:$D(SIGN) !,"E/S "_PROVNAM W:'$D(SIGN) !,PROVNAM
110 W !,"This prescription will be filled generically"
111 W !,"unless prescriber writes 'd a w' in the box below"
112 W !,"Refills: "_RFL
113 W !,"NR _____ Label _____ __________"
114 W !," | |"
115 W !," | |"
116 W !," | |"
117 W !," __________",!
118 W !,$P(+PATIEN,",")_"-"_$P(+PROVIEN,",")_"-"_$P(+RXIEN,",")
119 W $C(10)
120 D ACLOG
121 U IO(0)
122 Q
123FAX S %ZIS="QM",%ZIS("A")="Select fax machine: " D ^%ZIS
124 I POP W !,*7,"Prescription was not printed, going to next Prescription",!?10,*7,"Don't forget this prescription" Q
125 K %ZIS,IOP G:POP EXIT S PSOION=ION,PSOPIOST=$G(IOST(0))
126 N PSOIOS S PSOIOS=IOS,PSOQUE=$D(IO("Q"))
127 S DIC="^VEPER(19904.3,"
128 S DIC(0)="AEQMZ"
129 S DIC("A")="Enter recipient: "
130 D ^DIC
131 I Y=-1 W !,*7,"Prescription was not faxed, going on to next Prescription",!?10,*7,"Don't forget this prescription" Q
132 S VEPEREC=$P(Y(0),U),VEPENUM=$P(Y(0),U,5)
133 S VEPEPHARM=$P(Y,"^"),VEPEPHARM="1"_$E("000000",1,6-$L(VEPEPHARM))_VEPEPHARM
134 W !!,"Prescription(s) will be faxed to ",VEPEREC," at number: ",VEPENUM H 2
135 D DEV
136 Q
137PRINTER Q:VEPEIO'=""
138 S %ZIS="QM",%ZIS("A")="Select Prescription printer: " D ^%ZIS
139 I POP W !,*7,"Prescription was not printed, going to next Prescription",!?10,*7,"Don't forget this prescription" Q
140 ; *** Commented out next line for test, remove comment later ***
141 ;I IO'["|PRN|" U IO W !!,"Prescriptions will not print to your screen",!! C IO G PRINTER
142 S VEPEIO=IO
143 K %ZIS,IOP G:POP EXIT S PSOION=ION,PSOPIOST=$G(IOST(0))
144 N PSOIOS S PSOIOS=IOS,PSOQUE=$D(IO("Q"))
145 ; If desired insert printer alignment here, probably call ^PSOLBLT
146 Q
147DEV N FIL,DIR,IOP,X,Y,%ZIS W !
148 D HOME^%ZIS
149 S FIL=$$GET1^DIQ(59,"1,",92001.3)
150 S:PSOPRDEV="F" FIL=FIL_"\FAX\"_DT_VEPEPHARM_$P(RXIEN,",")_".DAT"
151 S:PSOPRDEV="E" FIL=FIL_"\HL7\"_DT_VEPEPHARM_$P(RXIEN,",")_".DAT"
152 S %ZIS="",%ZIS("HFSNAME")=FIL,%ZIS("HFSMODE")="W",IOP="HFS",(XPDSIZ,XPDSIZA)=0,XPDSEQ=1
153 D ^%ZIS
154 Q
155QUE S ZTRTN="PRNT2^VEPERXPR",ZTDESC="Print/Fax Prescription"
156 S ZTSAVE("PROVNAM")=PROVNAM,ZTSAVE("PATNAM")=PATNAM
157 S ZTSAVE("PROVIEN")=PROVIEN,ZTSAVE("PSOPRDEV")=PSOPRDEV
158 S ZTSAVE("PATIEN")=PATIEN,ZTSAVE("RXIEN")=RXIEN
159 S ZTSAVE("TITLE")=TITLE
160 S ZTSAVE("PROVCITY")=PROVCITY,ZTSAVE("PHONE")=PHONE,ZTSAVE("DEA")=DEA
161 S ZTSAVE("PATADD")=PATADD,ZTSAVE("AGE")=AGE,ZTSAVE("PATCITY")=PATCITY
162 S ZTSAVE("DRUG")=DRUG,ZTSAVE("QTY")=QTY,ZTSAVE("SIGN")=SIGN
163 S ZTSAVE("RFL")=RFL,ZTSAVE("PROVADD")=PROVADD
164 S N="" F S N=$O(RXARY(N)) Q:N="" S ZTSAVE("RXARY("_N_")")=RXARY(N)
165 D ^%ZTLOAD
166 W !!,$S($D(ZTSK):"Prescription has been queued, task # "_ZTSK,1:"Unable to queue prescription"),!!!
167 K ZTSK,IO("Q") D HOME^%ZIS
168 Q
169EDI N MSG,COUNT
170 D EN^VEPEHL7($P(RXIEN,","),.COUNT,.MSG)
171 S DIC="^VEPER(19904.3,"
172 S DIC(0)="AEQMZ"
173 S DIC("A")="Enter recipient: "
174 D ^DIC
175 I Y=-1 W !,*7,"Prescription was not transmitted, going on to next Prescription",!?10,*7,"Don't forget this prescription" Q
176 S VEPEREC=$P(Y(0),U),VEPENUM=$P(Y(0),U,5)
177 S VEPEPHARM=$P(Y,"^"),VEPEPHARM="1"_$E("000000",1,6-$L(VEPEPHARM))_VEPEPHARM
178 W !!,"Prescription(s) will be transmitted to ",VEPEREC H 2
179 D DEV
180 U IO F I=1:1:COUNT W MSG(I),!
181 D ^%ZISC
182 D ACLOG
183 U IO(0)
184 Q
185ACLOG ;Activity log
186 N DTTM,HCOM,HCNT,HJJ,HRXIEN,HRXEIN
187 S HRXIEN=$P(RXIEN,",")
188 S HRXEIN=$P(^PSRX($P(RXIEN,","),0),U)
189 D NOW^%DTC S DTTM=%
190 S:PSOPRDEV="F" HMSG=" faxed to "_VEPEREC
191 S:PSOPRDEV="E" HMSG=" transmitted to "_VEPEREC
192 S:PSOPRDEV="P" HMSG=" printed."
193 S HCOM="Prescription "_HRXEIN_HMSG
194 S HCNT=0
195 F HJJ=0:0 S HJJ=$O(^PSRX(HRXIEN,"A",HJJ)) Q:'HJJ S HCNT=HJJ
196 S HCNT=HCNT+1
197 S ^PSRX(HRXIEN,"A",0)="^52.3DA^"_HCNT_"^"_HCNT
198 S ^PSRX(HRXIEN,"A",HCNT,0)=DTTM_"^G^"_$G(DUZ)_"^0^"_HCOM
199 Q
200EXIT ;Exit
201 K RXNUM,RXIEN,FIELDS,VEPERX,PROV,PAT,PROVIEN,VEPEPROV,PROVNAM
202 K PATIEN,VEPEPAT,PATNAMN,VEPEIO
203 D ^%ZISC
204 Q
Note: See TracBrowser for help on using the repository browser.