| 1 | PSOARX1 ;BHAM ISC/SAB prints archive index only ; 01/20/95
|
|---|
| 2 | ;;7.0;OUTPATIENT PHARMACY;;DEC 1997
|
|---|
| 3 | W ! K ^TMP($J) I '$O(^PSOARC(0)) D G:'OUT EX G HDR
|
|---|
| 4 | .D ^PSOARCCO I '$O(^PSOARC(0)) W !,$C(7),"There is no data to print!" S OUT=0 Q
|
|---|
| 5 | .S OUT=1
|
|---|
| 6 | I $O(^PSOARC(0)) S OUT=1 D G:'$G(OUT)!($D(DIRUT)) EX
|
|---|
| 7 | .K DIR S DIR(0)="Y" S DIR("B")="NO",DIR("A",1)="There is data in the Pharmacy Archive file."
|
|---|
| 8 | .S DIR("A")="Do you want to re-compile this data" D ^DIR Q:$D(DIRUT)!('Y) D ^PSOARCCO
|
|---|
| 9 | .I '$O(^PSOARC(0)) W !,$C(7),"There is no data to print!" S OUT=0 Q
|
|---|
| 10 | HDR W ! K DIR S DIR("A")="Printout Header Label",DIR(0)="F^1:64",DIR("?",1)=" ...Enter 1 to 64 characters.",DIR("?")="This Header will print at top of every page of your index."
|
|---|
| 11 | S DIR("B")="Prescription Archive Data Index" D ^DIR K DIR G:$D(DIRUT) EX S PSOACDS=X K X
|
|---|
| 12 | K %ZIS,IO("Q"),ZTSK,ZTQUEUED S PSOION=ION,%ZIS="QM" D ^%ZIS I POP S IOP=PSOION D ^%ZIS K %ZIS,PSOION G EX
|
|---|
| 13 | I $D(IO("Q")) S ZTRTN="EN^PSOARX1",ZTSAVE("PSOACDS")="" D ^%ZTLOAD W:$D(ZTSK) !,"Task queued to print",! K ZTSK G EX
|
|---|
| 14 | EN K PSOQUIT S PSOAPG=1 D HD G:$G(PSQUIT) EX I '$O(^PSOARC(0)) U IO W !!,"**************There is no data to print****************",! G EX
|
|---|
| 15 | S ZI="" F S ZI=$O(^PSOARC("B",ZI)) Q:ZI="" S SSN=0 F PSOK=0:0 S SSN=$O(^PSOARC("B",ZI,SSN)) Q:SSN'>0 D G:$G(PSQUIT) EX
|
|---|
| 16 | .S NM=ZI,ZII=0,SS=SSN,LL=$L(NM)+$L(SS)+6
|
|---|
| 17 | .K ^TMP($J,"ZRX") F KK=0:0 S ZII=$O(^PSOARC("B",ZI,SSN,ZII)) Q:+ZII'>0 S ^TMP($J,"ZRX",ZII)="",LL=LL+$L(ZII)+1
|
|---|
| 18 | .U IO D:($Y+4)>IOSL HD Q:$G(PSQUIT)
|
|---|
| 19 | .W !,NM_" ("_$E(SSN,1,3)_"-"_$E(SSN,4,5)_"-"_$E(SSN,6,9)_") - " S ZII=0
|
|---|
| 20 | .F KK=1:1 S ZII=$O(^TMP($J,"ZRX",ZII)) Q:+ZII'>0 W:($X+$L(ZII)+1)>(IOM-5) !?($L(NM)+3) D:($Y+2)>IOSL HD Q:$G(PSQUIT) W $P(^PSRX(ZII,0),"^"),","
|
|---|
| 21 | ;print rx info
|
|---|
| 22 | S PSOP=IO,PSOACPF=IOF,PSOACPL=IOSL,PSOACPM=IOM,PSOATNM=1
|
|---|
| 23 | D HD Q:$G(PSQUIT)
|
|---|
| 24 | S ZI="" F S ZI=$O(^PSOARC("B",ZI)) Q:ZI="" S SSN=0 F PSOK=0:0 S SSN=$O(^PSOARC("B",ZI,SSN)) Q:SSN'>0 D G:$G(PSQUIT) EX
|
|---|
| 25 | .F ZII=0:0 S ZII=$O(^PSOARC("B",ZI,SSN,ZII)) Q:'ZII S (RX0,DA)=ZII U IO D:$Y+20>IOSL HD Q:$G(PSQUIT) D ^PSOARX
|
|---|
| 26 | EX D ^%ZISC K PSOPAG,PSOP,PSOACPF,PSOACPL,PSOACPM,PSOATNM,DIRUT,DUOUT,DTOUT,PG,PSOAC,PSOAC1,PSOACDS,PSOAPG,Y D:$D(ZTQUEUED) KILL^%ZTLOAD
|
|---|
| 27 | K POP,OUT,IO("Q"),%X,%Y,X,PSQUIT
|
|---|
| 28 | Q
|
|---|
| 29 | HD I IOST["C-" K DIR S DIR("A")="Press Return to Continue",DIR(0)="E" D ^DIR S:$D(DIRUT) PSQUIT=1 K DIR,DIRUT,DUOUT Q:$G(PSQUIT)
|
|---|
| 30 | U IO W @IOF,!!?(IOM-$L(PSOACDS)\2),PSOACDS,?$X+10," Page: "_PSOAPG
|
|---|
| 31 | W !?(IOM-$L($E(DT,4,5)_"/"_$E(DT,6,7)_"/"_$E(DT,2,3))\2),$E(DT,4,5)_"/"_$E(DT,6,7)_"/"_$E(DT,2,3),! S PSOAPG=PSOAPG+1 Q
|
|---|
