source: FOIAVistA/trunk/r/OUTPATIENT_PHARMACY-PSO-APSP-HUIP/PSOSURST.m@ 1397

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

initial load of FOIAVistA 6/30/08 version
File size: 5.2 KB
Line 
1PSOSURST ;BIR/RTR-Reset and Reprint from Suspense ; 7/20/96
2 ;;7.0;OUTPATIENT PHARMACY;**10**;DEC 1997
3 D:'$D(PSOPAR) ^PSOLSET I '$D(PSOPAR) G END
4 N X S X="PSXRPPL1" X ^%ZOSF("TEST") K X G:'$T START
5 G:$G(PSXSYS)&($D(^XUSEC("PSXCMOPMGR",DUZ)))&($D(^XUSEC("PSX XMIT",DUZ))) ^PSXRPPL1
6START W !!,"Enter a date range to see all batches printed from suspense within those dates."
7BEG K ^TMP($J,"PSORES"),^TMP($J,"PSORESPR"),^UTILITY($J,"PSOREPT"),PSOOUT,DTOUT,PSOLISTY
8 W ! K %DT S %DT="AEX",%DT("A")="Start date: " D ^%DT K %DT G:Y<0!($D(DTOUT)) END S (%DT(0),BEGDATE)=Y W ! S %DT="AEX",%DT("A")="End date: " D ^%DT K %DT G:Y<0!($D(DTOUT)) END S ENDDATE=Y
9 S BEGDATE=BEGDATE-.0001,ENDDATE=ENDDATE+.9999,RECNT=1 W !!,"Gathering batches, please wait...",! H 1
10 F ZZZ=BEGDATE:0 S ZZZ=$O(^PS(52.5,"AS",ZZZ)) Q:'ZZZ!(ZZZ>ENDDATE) F XXX=0:0 S XXX=$O(^PS(52.5,"AS",ZZZ,XXX)) Q:'XXX F MMM=0:0 S MMM=$O(^PS(52.5,"AS",ZZZ,XXX,MMM)) Q:'MMM D
11 .I MMM=$G(PSOSITE) S ^TMP($J,"PSORES",RECNT,ZZZ,XXX,MMM)="",RECNT=RECNT+1
12 I '$D(^TMP($J,"PSORES")) W $C(7),!!,"There are no printed batches found for that date range!",! G BEG
13 H 1 W @IOF W !?1,"BATCH",?10,"QUEUED TO PRINT ON:",?40,"PRINTED BY:",?56,$E($P($G(^PS(59,PSOSITE,0)),"^"),1,23),! F AA=1:1:78 W "-"
14 W ! F AAA=0:0 S AAA=$O(^TMP($J,"PSORES",AAA)) Q:'AAA!($G(PSOOUT)) S PSIDATE=$O(^TMP($J,"PSORES",AAA,0)),PSODUZ=$O(^TMP($J,"PSORES",AAA,PSIDATE,0)) D
15 .S Y=PSIDATE X ^DD("DD") S PSODATE=Y,PSOUSER=$S($D(^VA(200,PSODUZ,0)):$P($G(^(0)),"^"),1:"UNKNOWN") D:($Y+5)>IOSL Q:$G(PSOOUT) W !?2,AAA,?10,PSODATE,?40,PSOUSER
16 ..W ! K DIR S DIR(0)="E" D ^DIR K DIR S:'Y PSOOUT=1 I Y W @IOF W !?1,"BATCH",?10,"QUEUED TO PRINT ON:",?40,"PRINTED BY:",?56,$E($P($G(^PS(59,PSOSITE,0)),"^"),1,23),! F AA=1:1:78 W "-"
17 I $G(PSOOUT),Y="" G END
18 S RECNT=RECNT-1,PSOOUT=0 W ! K DIR S DIR("A")="Select Batch(s) to reprint",DIR(0)="L^1:"_RECNT D ^DIR K DIR I Y["^"!($D(DTOUT))!($D(DUOUT)) W !!?3,"Nothing queued to print!",! G START
19 S COUNT=1 F ZZ=1:1:$L(Y) S ZZZ=$E(Y,ZZ) I ZZZ="," S COUNT=COUNT+1
20 S COUNT=COUNT-1 F JJ=1:1:COUNT S RR=$P(Y,",",JJ),^TMP($J,"PSORESPR",RR)=""
21YLOOP I $G(Y(1)) F PSYLOOP=0:0 S PSYLOOP=$O(Y(PSYLOOP)) Q:'PSYLOOP D
22 .S COUNT=1 F ZZ=1:1:$L(Y(PSYLOOP)) S ZZZ=$E(Y(PSYLOOP),ZZ) I ZZZ="," S COUNT=COUNT+1
23 .S COUNT=COUNT-1 F JJ=1:1:COUNT S RR=$P(Y(PSYLOOP),",",JJ),^TMP($J,"PSORESPR",RR)=""
24 W !!,"Batches selected for Reprint are:",! F ZZZ=0:0 S ZZZ=$O(^TMP($J,"PSORESPR",ZZZ)) Q:'ZZZ D
25 .S PSIDATE=$O(^TMP($J,"PSORES",ZZZ,0)),PSODUZ=$O(^TMP($J,"PSORES",ZZZ,PSIDATE,0)) S Y=PSIDATE X ^DD("DD") S PSODATE=Y,PSOUSER=$S($D(^VA(200,PSODUZ,0)):$P($G(^(0)),"^"),1:"UNKNOWN")
26 .W !,"Batch ",ZZZ," Queued for ",PSODATE," by ",PSOUSER
27 W ! K DIR S DIR(0)="Y",DIR("B")="N",DIR("A")="Before Reprinting, would you like a list of these prescriptions" D ^DIR K DIR I Y["^"!($D(DTOUT)) W !!?3,"Nothing queued to print!",! G START
28 I Y W ! S PSOLISTY=1 S DIR(0)="SB^S:SCREEN;P:PRINTER",DIR("A")="Print list to the screen or to a printer",DIR("B")="Screen" D ^DIR K DIR I $D(DIRUT) W !!?3,"Nothing queued to print!",! G START
29 I $G(PSOLISTY),Y="P" D ^PSOSUBCH G START
30 I $G(PSOLISTY) D LIST I $G(PSOOUT) G START
31QUE W ! K %DT D NOW^%DTC S %DT="REAX",%DT(0)=%,%DT("B")="NOW",%DT("A")="Queue labels to reprint at what time: " D ^%DT K %DT I $D(DTOUT)!(Y<0) W !!?3,"Nothing queued to print!",! G START
32 S PSOSUREP=1,PSORTIME=Y
33 W ! S %ZIS("A")="REPRINT LABEL DEVICE: ",%ZIS("B")="",%ZIS="MQN" D ^%ZIS I POP!($E(IOST)["C") G START
34 N PSOIOS S PSOIOS=IOS D DEVBAR^PSOBMST
35 S PSOBARS=PSOBAR1]""&(PSOBAR0]"")&$P(PSOPAR,"^",19)
36 S PSOREDEV=ION
37 S ZTRTN="BEG^PSOSUSRP",ZTDTH=PSORTIME,ZTIO=PSOREDEV,ZTDESC="REPRINT LABELS FROM SUSPENSE"
38 F GG="PSOPAR","PSOSYS","PSOSITE","PSOSUREP","PSOBARS","PSOBAR0","PSOBAR1" S:$D(@GG) ZTSAVE(GG)=""
39 F NNN=0:0 S NNN=$O(^TMP($J,"PSORESPR",NNN)) Q:'NNN D
40 .S PSRDATE=$O(^TMP($J,"PSORES",NNN,0)),PSRDUZ=$O(^TMP($J,"PSORES",NNN,PSRDATE,0)),PSRDIV=$O(^TMP($J,"PSORES",NNN,PSRDATE,PSRDUZ,0))
41 .S ^UTILITY($J,"PSOREPT",PSRDATE,PSRDUZ,PSRDIV)=""
42 S ZTSAVE("^UTILITY($J,""PSOREPT"",")="" D ^%ZTLOAD
43 W !!,"REPRINTED LABELS QUEUED TO PRINT!",!
44END K ^TMP($J,"PSORES"),^TMP($J,"PSORESPR"),^UTILITY($J,"PSOREPT"),%DT,%ZIS,AA,AAA,BEGDATE,COUNT,DUOUT,DTOUT,ENDDATE,GG,INRX,JJ,LLL,MMM,NNN,POP,PSIDATE,PSODATE,PSODUZ,PSOREDEV,PSORTIME,PSOSUREP,PSOUSER,PSYLOOP
45 K PSRDATE,PSRDIV,PSOLISTY,PSRDUZ,RECNT,REDT,REDUZ,RR,SS,XXX,ZZ,ZZZ,ZZZ D ^%ZISC Q
46LIST F LLL=0:0 S LLL=$O(^TMP($J,"PSORESPR",LLL)) Q:'LLL!($G(PSOOUT)) D
47 .W ! S DIR(0)="E" D ^DIR K DIR S:'Y PSOOUT=1 Q:$G(PSOOUT) D HEAD S REDT=$O(^TMP($J,"PSORES",LLL,0)),REDUZ=$O(^TMP($J,"PSORES",LLL,REDT,0)) F SS=0:0 S SS=$O(^PS(52.5,"AS",REDT,REDUZ,PSOSITE,SS)) Q:'SS!($G(PSOOUT)) D
48 ..F GG=0:0 S GG=$O(^PS(52.5,"AS",REDT,REDUZ,PSOSITE,SS,GG)) Q:'GG!($G(PSOOUT)) D:($Y+5)>IOSL HEADONE Q:$G(PSOOUT) I $D(^PS(52.5,GG,0)),$P($G(^(0)),"^",6)=PSOSITE S INRX=$P(^(0),"^") I $D(^PSRX(INRX,0)) D
49 ...W !,$P(^PSRX(INRX,0),"^"),?20,$P($G(^DPT(+$P(^PSRX(INRX,0),"^",2),0)),"^"),?60,$S($P($G(^PS(52.5,GG,0)),"^",5):"(PARTIAL)",$P($G(^(0)),"^",12):"(REPRINT)",1:"")
50 I $G(PSOOUT),(Y="") Q
51 S PSOOUT=0 I Y'=0 W !,"END OF LIST"
52 Q
53HEAD W @IOF W !,"RX #",?20,"PATIENT NAME",?60,"BATCH ",LLL,! F ZZZZ=1:1:78 W "-"
54 Q
55HEADONE S DIR(0)="E" D ^DIR K DIR I 'Y S PSOOUT=1 Q
56 W @IOF W !,"RX #",?20,"PATIENT NAME",?60,"BATCH ",LLL,! F ZZZZ=1:1:78 W "-"
57 Q
Note: See TracBrowser for help on using the repository browser.