205 lines
8.0 KiB
Mathematica
205 lines
8.0 KiB
Mathematica
VEPERXPR ;DAOU/JLG&MRM - Rx Print ; 4/14/05 9:13am
|
|
;;1.0;t1;VO Pharmacy; Mar 25, 2005;Build 1
|
|
; -----
|
|
INIT ; Set up variables.
|
|
S VEPEIO=""
|
|
N RXNUM,IENS,FIELDS,VEPERX,PROV,PAT,PROVIEN,VEPEPROV,PROVNAM
|
|
N PATIEN,VEPEPAT,PATNAMN
|
|
CHK ;Check for Rx interactions.
|
|
S PPL1=1 S:'$G(PPL) PPL=$G(PSORX("PSOL",PPL1))
|
|
G:$G(PPL)']"" D1
|
|
CHK2 K SPPL G:$D(DTOUT) D1 S SPPL="" F PI=1:1 Q:$P(PPL,",",PI)="" D
|
|
.S DA=$P(PPL,",",PI)
|
|
.I $P(^PSRX(DA,"STA"),"^")=4 S SPPL=SPPL_DA_"," Q
|
|
I $G(SPPL)]"" D
|
|
.W !!,$C(7),"Drug Interaction Rx(s) "
|
|
.F I=1:1 Q:$P(SPPL,",",I)="" W $P(^PSRX($P(SPPL,",",I),0),"^")_", "
|
|
.S PPL=SPPL,DG=1 D Q1 K DG,SPPL
|
|
D1 K RXLTOP
|
|
I $G(PPL1),$O(PSORX("PSOL",$G(PPL1))) S PPL1=$O(PSORX("PSOL",PPL1)),PPL=PSORX("PSOL",PPL1) G GETINFO
|
|
I $G(PPL1),$O(PSORX("PSOL",$G(PPL1))) D Q G GETINFO
|
|
.S PPL1=$O(PSORX("PSOL",PPL1)),PPL=PSORX("PSOL",PPL1)
|
|
Q1 S PPL1=1 G:$G(PPL)']"" D1 S PSNP=0,PSL=1
|
|
D I $G(PSOFROM)="NEW",$P(PSOPAR,"^",8) S PSNP=1
|
|
.Q:'$P(PSOPAR,"^",8)!($G(PSONOPRT))
|
|
.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
|
|
;
|
|
;Apparently the subscripts of RXFL contain the Rx numbers
|
|
GETINFO S RXNUM=0
|
|
F S RXNUM=$O(RXFL(RXNUM)) Q:RXNUM="" D
|
|
. D RX,PROV,INST,PAT,PRINT
|
|
. K RXFL(RXNUM)
|
|
. S:'$D(RXNUM)&$D(RXIEN) RXNUM=+RXIEN
|
|
D EXIT
|
|
Q
|
|
RX S RXIEN=RXNUM
|
|
S FIELDS="1;2;4;6;7;9;10.1;26"
|
|
;Fields are patient,provider,drug,QTY,#refills,Sig1
|
|
D GETS^DIQ(52,RXIEN,FIELDS,"R","VEPERX")
|
|
S Y=$$GET1^DIQ(52,RXIEN,39.1,"","RXARY")
|
|
S RXIEN=RXIEN_","
|
|
S PAT=VEPERX(52,RXIEN,"PATIENT"),PROV=VEPERX(52,RXIEN,"PROVIDER")
|
|
S DRUG=VEPERX(52,RXIEN,"DRUG"),QTY=VEPERX(52,RXIEN,"QTY")
|
|
S RFL=VEPERX(52,RXIEN,"# OF REFILLS")
|
|
S SIGN=$S(VEPERX(52,RXIEN,"OERR SIG")="YES":1,1:0)
|
|
Q
|
|
PROV ;Get provider information
|
|
D FIND^DIC(200,"","","",PROV,"","B","","","VEPEPROV")
|
|
S PROVIEN=VEPEPROV("DILIST",2,1)
|
|
;ADDRESS, CITY, STATE, ZIP, PHONE, TITLE, DEA #, ELECTRONIC SIG
|
|
K VEPEPROV
|
|
S FIELDS=".01;.132;8;53.2;16*;70"
|
|
D GETS^DIQ(200,PROVIEN,FIELDS,"R","VEPEPROV")
|
|
S PROVNAM=$P(PROV,",",2)_" "_$P(PROV,",",1),PROVIEN=PROVIEN_","
|
|
S DEA=VEPEPROV(200,PROVIEN,"DEA#"),PHONE=VEPEPROV(200,PROVIEN,"OFFICE PHONE")
|
|
S TITLE=VEPEPROV(200,PROVIEN,"TITLE"),N=""
|
|
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")
|
|
Q
|
|
INST ;Get institute information
|
|
D FIND^DIC(4,"","","",INST,"","B","","","VEPEINST")
|
|
S INSTIEN=VEPEINST("DILIST",2,1)
|
|
K VEPEINST
|
|
S FIELDS="1.01;1.02;1.03;1.04;4.04"
|
|
D GETS^DIQ(4,INSTIEN,FIELDS,"R","VEPEINST")
|
|
S INSTIEN=INSTIEN_","
|
|
S PROVCITY=VEPEINST(4,INSTIEN,"CITY"),PROVCITY=PROVCITY_", "_VEPEINST(4,INSTIEN,"STATE (MAILING)")
|
|
S PROVCITY=PROVCITY_" "_VEPEINST(4,INSTIEN,"ZIP")
|
|
S:$D(VEPEINST(4,INSTIEN,"STREET ADDR. 1")) PROVADD=VEPEINST(4,INSTIEN,"STREET ADDR. 1")
|
|
S:$D(VEPEINST(4,INSTIEN,"STREET ADDR. 2")) PROVADD=PROVADD_" "_VEPEINST(4,INSTIEN,"STREET ADDR. 2")
|
|
Q
|
|
PAT ;Get patient information
|
|
D FIND^DIC(2,"","","",PAT,"","B","","","VEPEPAT")
|
|
S PATIEN=VEPEPAT("DILIST",2,1)
|
|
;AGE,ADDRESS
|
|
S FIELDS=".033;.111;.112;.113;.114;.115;.116"
|
|
D GETS^DIQ(2,PATIEN,FIELDS,"R","VEPEPAT")
|
|
S PATNAM=$P(PAT,",",2)_" "_$P(PAT,",",1),PATIEN=PATIEN_","
|
|
S AGE=VEPEPAT(2,PATIEN,"AGE")
|
|
S PATADD1=VEPEPAT(2,PATIEN,"STREET ADDRESS [LINE 1]")
|
|
S PATADD2=VEPEPAT(2,PATIEN,"STREET ADDRESS [LINE 2]")
|
|
S PATADD3=VEPEPAT(2,PATIEN,"STREET ADDRESS [LINE 3]")
|
|
S PATADD=$S($D(PATADD1):PATADD1,1:"")_$S($D(PATADD2):PATADD2,1:"")
|
|
S PATADD=PATADD_$S($D(PATADD3):PATADD3,1:"")
|
|
S PATCITY=VEPEPAT(2,PATIEN,"CITY")_", "_VEPEPAT(2,PATIEN,"STATE")
|
|
S PATCITY=PATCITY_VEPEPAT(2,PATIEN,"ZIP CODE")
|
|
Q
|
|
PRINT ;Print prescription
|
|
D:PSOPRDEV="F" FAX D:PSOPRDEV="P" PRINTER D:PSOPRDEV="E" EDI
|
|
Q:PSOPRDEV="E"
|
|
Q:POP
|
|
S %DT="T",X="N" D ^%DT S $P(^PSRX(52,92001),U,1)=+Y
|
|
S $P(^PSRX(52,92001),U,2)=PSOPRDEV
|
|
G:'Y EXIT
|
|
U IO
|
|
PRINT2 W !,PROVNAM W:$D(TITLE) ", "_TITLE
|
|
W:$D(PROVADD) !,PROVADD
|
|
W !,PROVCITY
|
|
W:$D(PHONE) !,PHONE_" "
|
|
W:'$D(PHONE) ! W "DEA #:"_DEA
|
|
W !,"__________________________________________________"
|
|
W !,$$FMTE^XLFDT(DT,1)
|
|
W !,PATNAM_" AGE: "_AGE
|
|
W !,PATADD,PATCITY
|
|
W !!," Rx ",!
|
|
W !," "_DRUG
|
|
W !," QTY: "_QTY
|
|
I $D(RXARY) S N="" F S N=$O(RXARY(N)) Q:N="" W !,RXARY(N)
|
|
W !!!
|
|
W !,"Signature: ____________________________________"
|
|
W:$D(SIGN) !,"E/S "_PROVNAM W:'$D(SIGN) !,PROVNAM
|
|
W !,"This prescription will be filled generically"
|
|
W !,"unless prescriber writes 'd a w' in the box below"
|
|
W !,"Refills: "_RFL
|
|
W !,"NR _____ Label _____ __________"
|
|
W !," | |"
|
|
W !," | |"
|
|
W !," | |"
|
|
W !," __________",!
|
|
W !,$P(+PATIEN,",")_"-"_$P(+PROVIEN,",")_"-"_$P(+RXIEN,",")
|
|
W $C(10)
|
|
D ACLOG
|
|
U IO(0)
|
|
Q
|
|
FAX S %ZIS="QM",%ZIS("A")="Select fax machine: " D ^%ZIS
|
|
I POP W !,*7,"Prescription was not printed, going to next Prescription",!?10,*7,"Don't forget this prescription" Q
|
|
K %ZIS,IOP G:POP EXIT S PSOION=ION,PSOPIOST=$G(IOST(0))
|
|
N PSOIOS S PSOIOS=IOS,PSOQUE=$D(IO("Q"))
|
|
S DIC="^VEPER(19904.3,"
|
|
S DIC(0)="AEQMZ"
|
|
S DIC("A")="Enter recipient: "
|
|
D ^DIC
|
|
I Y=-1 W !,*7,"Prescription was not faxed, going on to next Prescription",!?10,*7,"Don't forget this prescription" Q
|
|
S VEPEREC=$P(Y(0),U),VEPENUM=$P(Y(0),U,5)
|
|
S VEPEPHARM=$P(Y,"^"),VEPEPHARM="1"_$E("000000",1,6-$L(VEPEPHARM))_VEPEPHARM
|
|
W !!,"Prescription(s) will be faxed to ",VEPEREC," at number: ",VEPENUM H 2
|
|
D DEV
|
|
Q
|
|
PRINTER Q:VEPEIO'=""
|
|
S %ZIS="QM",%ZIS("A")="Select Prescription printer: " D ^%ZIS
|
|
I POP W !,*7,"Prescription was not printed, going to next Prescription",!?10,*7,"Don't forget this prescription" Q
|
|
; *** Commented out next line for test, remove comment later ***
|
|
;I IO'["|PRN|" U IO W !!,"Prescriptions will not print to your screen",!! C IO G PRINTER
|
|
S VEPEIO=IO
|
|
K %ZIS,IOP G:POP EXIT S PSOION=ION,PSOPIOST=$G(IOST(0))
|
|
N PSOIOS S PSOIOS=IOS,PSOQUE=$D(IO("Q"))
|
|
; If desired insert printer alignment here, probably call ^PSOLBLT
|
|
Q
|
|
DEV N FIL,DIR,IOP,X,Y,%ZIS W !
|
|
D HOME^%ZIS
|
|
S FIL=$$GET1^DIQ(59,"1,",92001.3)
|
|
S:PSOPRDEV="F" FIL=FIL_"\FAX\"_DT_VEPEPHARM_$P(RXIEN,",")_".DAT"
|
|
S:PSOPRDEV="E" FIL=FIL_"\HL7\"_DT_VEPEPHARM_$P(RXIEN,",")_".DAT"
|
|
S %ZIS="",%ZIS("HFSNAME")=FIL,%ZIS("HFSMODE")="W",IOP="HFS",(XPDSIZ,XPDSIZA)=0,XPDSEQ=1
|
|
D ^%ZIS
|
|
Q
|
|
QUE S ZTRTN="PRNT2^VEPERXPR",ZTDESC="Print/Fax Prescription"
|
|
S ZTSAVE("PROVNAM")=PROVNAM,ZTSAVE("PATNAM")=PATNAM
|
|
S ZTSAVE("PROVIEN")=PROVIEN,ZTSAVE("PSOPRDEV")=PSOPRDEV
|
|
S ZTSAVE("PATIEN")=PATIEN,ZTSAVE("RXIEN")=RXIEN
|
|
S ZTSAVE("TITLE")=TITLE
|
|
S ZTSAVE("PROVCITY")=PROVCITY,ZTSAVE("PHONE")=PHONE,ZTSAVE("DEA")=DEA
|
|
S ZTSAVE("PATADD")=PATADD,ZTSAVE("AGE")=AGE,ZTSAVE("PATCITY")=PATCITY
|
|
S ZTSAVE("DRUG")=DRUG,ZTSAVE("QTY")=QTY,ZTSAVE("SIGN")=SIGN
|
|
S ZTSAVE("RFL")=RFL,ZTSAVE("PROVADD")=PROVADD
|
|
S N="" F S N=$O(RXARY(N)) Q:N="" S ZTSAVE("RXARY("_N_")")=RXARY(N)
|
|
D ^%ZTLOAD
|
|
W !!,$S($D(ZTSK):"Prescription has been queued, task # "_ZTSK,1:"Unable to queue prescription"),!!!
|
|
K ZTSK,IO("Q") D HOME^%ZIS
|
|
Q
|
|
EDI N MSG,COUNT
|
|
D EN^VEPEHL7($P(RXIEN,","),.COUNT,.MSG)
|
|
S DIC="^VEPER(19904.3,"
|
|
S DIC(0)="AEQMZ"
|
|
S DIC("A")="Enter recipient: "
|
|
D ^DIC
|
|
I Y=-1 W !,*7,"Prescription was not transmitted, going on to next Prescription",!?10,*7,"Don't forget this prescription" Q
|
|
S VEPEREC=$P(Y(0),U),VEPENUM=$P(Y(0),U,5)
|
|
S VEPEPHARM=$P(Y,"^"),VEPEPHARM="1"_$E("000000",1,6-$L(VEPEPHARM))_VEPEPHARM
|
|
W !!,"Prescription(s) will be transmitted to ",VEPEREC H 2
|
|
D DEV
|
|
U IO F I=1:1:COUNT W MSG(I),!
|
|
D ^%ZISC
|
|
D ACLOG
|
|
U IO(0)
|
|
Q
|
|
ACLOG ;Activity log
|
|
N DTTM,HCOM,HCNT,HJJ,HRXIEN,HRXEIN
|
|
S HRXIEN=$P(RXIEN,",")
|
|
S HRXEIN=$P(^PSRX($P(RXIEN,","),0),U)
|
|
D NOW^%DTC S DTTM=%
|
|
S:PSOPRDEV="F" HMSG=" faxed to "_VEPEREC
|
|
S:PSOPRDEV="E" HMSG=" transmitted to "_VEPEREC
|
|
S:PSOPRDEV="P" HMSG=" printed."
|
|
S HCOM="Prescription "_HRXEIN_HMSG
|
|
S HCNT=0
|
|
F HJJ=0:0 S HJJ=$O(^PSRX(HRXIEN,"A",HJJ)) Q:'HJJ S HCNT=HJJ
|
|
S HCNT=HCNT+1
|
|
S ^PSRX(HRXIEN,"A",0)="^52.3DA^"_HCNT_"^"_HCNT
|
|
S ^PSRX(HRXIEN,"A",HCNT,0)=DTTM_"^G^"_$G(DUZ)_"^0^"_HCOM
|
|
Q
|
|
EXIT ;Exit
|
|
K RXNUM,RXIEN,FIELDS,VEPERX,PROV,PAT,PROVIEN,VEPEPROV,PROVNAM
|
|
K PATIEN,VEPEPAT,PATNAMN,VEPEIO
|
|
D ^%ZISC
|
|
Q
|