source: FOIAVistA/trunk/r/CMOP-PSX/PSXARPT.m@ 811

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

initial load of FOIAVistA 6/30/08 version

File size: 3.1 KB
Line 
1PSXARPT ;BIR/HTW-Print Archived data [ 04/08/97 2:06 PM ]
2 ;;2.0;CMOP;;11 Apr 97
3 S PSXRPT=1,COMCT=1,LBLCT=1
4 S DIC=555,DIC(0)="AEMQZ"
5 S DIC("A")="Enter Archived CMOP Transmission Number: " D ^DIC K DIC
6 Q:$D(DUOUT)!($D(DTOUT))!(+$G(Y)'>0)
7 S PSXBATCH=$P(Y,"^",2),PSXTNO=$P(^PSXARC(+Y,0),"^",2)
8 S DIR(0)="F^1:15",DIR("A")="Enter Rx # to report or return for all"
9 S DIR("B")="ALL"
10 D ^DIR K DIR I $D(DIRUT)!($D(DIROUT)) Q
11 S RX=Y K Y
12 ; Get printer and tape device info
13DEVICE W !! S %ZIS="MQ",%ZIS("A")="Select Printer: ",%ZIS("B")=""
14 D ^%ZIS I POP S PSXERR=1 G END
15 S PSXP=IO K %ZIS
16 S PSXPIOF=IOF,PSXPIOST=IOST
17 D MOUNT^PSXARC I $G(PSXERR)=1 G END
18 ; verify correct tape
19MAIN U PSXT R X:DTIME G END:X=""
20 I X["$$HDR|" S PSXTAPE=$P($P(X,"|",2),"^",2)
21 I $G(PSXTAPE)'=$G(PSXTNO) U IO(0) W !,"The wrong archive tape has been loaded. This is tape #: "_$S($G(PSXTAPE)']"":"UNKNOWN",1:PSXTAPE) K PSXTAPE,X D MOUNT^PSXARC G:($G(PSXERR)=1) END G MAIN
22 I $G(PSXP)'=IO(0) U IO(0) W !,"Searching...."
23FIND ; Find selected batch
24 D PSXAT^PSXARC1 U PSXT R X:DTIME G END:X=""
25 I X'["$$REC|"!((X["$$REC|")&(X'[PSXBATCH)) G FIND
26 I $G(PSXP)'=IO(0) U IO(0) W !,$P($P(X,"|",2),"^")_", "
27 I X[PSXBATCH G A1
28 U IO(0) W !!,"Batch not found, please try again." G END
29 Q
30ALL D PSXAT^PSXARC1 R X:DTIME G END:X=""
31A1 I X["$$REC|"&(X'[PSXBATCH) G END
32 I $G(X)["$$REC|",($D(REC)) S XZ=X D ^PSXARC2 S X=XZ K XZ
33 I $G(X)["$$REC|" S REC=X G ALL
34 I $G(X)["$$COM|" S COM(COMCT)=X S COMCT=COMCT+1 G ALL
35 I $G(X)["$$LBL|" S LBL(LBLCT)=X S LBLCT=LBLCT+1 G ALL
36 I $G(X)["$$ACK|" S ACK=X G ALL
37 I $D(REC),($G(X)["$$RX,1") S RXX=X D ^PSXARC2 S X=RXX K REC,COM,LBL,ACK,RXX
38RX I +$G(RX)>0 G SING1
39 I $G(X)["$$RX," S REC1=$P(X,"|",2) G ALL
40 I $G(X)["$$ZX,"&($D(REC1)) S REC2=$P(X,"|",2) D RX^PSXARC2 K REC1,REC2 G ALL
41 I $G(X)["$$LOT" S LOT=$P(X,"|",2) D LOT^PSXARC2 K LOT G ALL
42 Q
43SING1 I X[RX G S1
44SINGLE U PSXT R X:DTIME G ERR:X="" G:X'["$$RX" SINGLE I X'[RX G SINGLE
45S1 S REC1=$P(X,"|",2)
46S2 U PSXT R X:DTIME G END:X=""
47 I $G(X)["$$ZX,"&($D(REC1)) S REC2=$P(X,"|",2) D RX^PSXARC2 K REC1,REC2 G S2
48 I $G(X)["$$LOT" S LOT=$P(X,"|",2) D LOT^PSXARC2 K LOT G S2
49 G END
50ERR U IO(0) W !,"Rx not found. Please make sure the number is correct."
51 D END G PSXARPT
52 ;
53END I $G(PSXP)'=IO(0),($G(PSXERR)'=1) U PSXP W @PSXPIOF
54 D ^%ZISC
55 S DEV="" F S DEV=$O(IO(1,DEV)) Q:($G(DEV)'>0) S IOP=DEV D ^%ZIS,^%ZISC
56 D HOME^%ZIS
57 K PSXT,PSXP,RX,LOT,X,PSXEOT,PSXBATCH,REC,REC1,COM,LBL,ACK,XX,ZCT,PSXTAPE
58 K ZQ,ZQ1,PSXAM,PSXPIOF,PSXPIOST,PSXRPT,PSXTBS,PSXTIOF,PSXTNO,PSXTPAR,XZ
59 K Y,LBLCT,COMCT,C,ZPC,POP,%MT,DIROUT,DIRUT,DTOUT,DUOUT,PSXERR,RXX,XNEW
60 Q
61DUMP ; DUMPS CONTENTS OF TAPE - NO FORMATTING
62PQ S XNEW=0,PSXATNM=1 S %ZIS("A")="TAPE DRIVE DEVICE: " W !! D ^%ZIS K %ZIS("A") G END:POP S PSXAT=IO I IOST'["MAGTAPE" D ^%ZISC U IO(0) W !,"MUST SELECT A MAGTAPE DEVICE",!! G PQ
63 U IO(0) W !! S %ZIS("A")="OUTPUT DEVICE: " D ^%ZIS K %ZIS("A") S PSXAP=IO G END:POP S PSXACPM=IOM,PSXACPF=IOF,PSXACPL=IOSL W !!
64 I '$D(%MT("REW")) X ^%ZOSF("MAGTAPE")
65 F U PSXAT R X:DTIME U PSXAP W !,X S ZAL=$G(ZAL)+$L(X) X ^%ZOSF("EOT") G:Y END I $G(X)']"" G STOP
66STOP D ^%ZISC
67 K PSXAT,PSXACPF,PSXACPL,PSXAP,PSXACPM,PSXATNM,ZAL
68 Q
Note: See TracBrowser for help on using the repository browser.