69 lines
3.1 KiB
Mathematica
69 lines
3.1 KiB
Mathematica
PSXARPT ;BIR/HTW-Print Archived data [ 04/08/97 2:06 PM ]
|
|
;;2.0;CMOP;;11 Apr 97
|
|
S PSXRPT=1,COMCT=1,LBLCT=1
|
|
S DIC=555,DIC(0)="AEMQZ"
|
|
S DIC("A")="Enter Archived CMOP Transmission Number: " D ^DIC K DIC
|
|
Q:$D(DUOUT)!($D(DTOUT))!(+$G(Y)'>0)
|
|
S PSXBATCH=$P(Y,"^",2),PSXTNO=$P(^PSXARC(+Y,0),"^",2)
|
|
S DIR(0)="F^1:15",DIR("A")="Enter Rx # to report or return for all"
|
|
S DIR("B")="ALL"
|
|
D ^DIR K DIR I $D(DIRUT)!($D(DIROUT)) Q
|
|
S RX=Y K Y
|
|
; Get printer and tape device info
|
|
DEVICE W !! S %ZIS="MQ",%ZIS("A")="Select Printer: ",%ZIS("B")=""
|
|
D ^%ZIS I POP S PSXERR=1 G END
|
|
S PSXP=IO K %ZIS
|
|
S PSXPIOF=IOF,PSXPIOST=IOST
|
|
D MOUNT^PSXARC I $G(PSXERR)=1 G END
|
|
; verify correct tape
|
|
MAIN U PSXT R X:DTIME G END:X=""
|
|
I X["$$HDR|" S PSXTAPE=$P($P(X,"|",2),"^",2)
|
|
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
|
|
I $G(PSXP)'=IO(0) U IO(0) W !,"Searching...."
|
|
FIND ; Find selected batch
|
|
D PSXAT^PSXARC1 U PSXT R X:DTIME G END:X=""
|
|
I X'["$$REC|"!((X["$$REC|")&(X'[PSXBATCH)) G FIND
|
|
I $G(PSXP)'=IO(0) U IO(0) W !,$P($P(X,"|",2),"^")_", "
|
|
I X[PSXBATCH G A1
|
|
U IO(0) W !!,"Batch not found, please try again." G END
|
|
Q
|
|
ALL D PSXAT^PSXARC1 R X:DTIME G END:X=""
|
|
A1 I X["$$REC|"&(X'[PSXBATCH) G END
|
|
I $G(X)["$$REC|",($D(REC)) S XZ=X D ^PSXARC2 S X=XZ K XZ
|
|
I $G(X)["$$REC|" S REC=X G ALL
|
|
I $G(X)["$$COM|" S COM(COMCT)=X S COMCT=COMCT+1 G ALL
|
|
I $G(X)["$$LBL|" S LBL(LBLCT)=X S LBLCT=LBLCT+1 G ALL
|
|
I $G(X)["$$ACK|" S ACK=X G ALL
|
|
I $D(REC),($G(X)["$$RX,1") S RXX=X D ^PSXARC2 S X=RXX K REC,COM,LBL,ACK,RXX
|
|
RX I +$G(RX)>0 G SING1
|
|
I $G(X)["$$RX," S REC1=$P(X,"|",2) G ALL
|
|
I $G(X)["$$ZX,"&($D(REC1)) S REC2=$P(X,"|",2) D RX^PSXARC2 K REC1,REC2 G ALL
|
|
I $G(X)["$$LOT" S LOT=$P(X,"|",2) D LOT^PSXARC2 K LOT G ALL
|
|
Q
|
|
SING1 I X[RX G S1
|
|
SINGLE U PSXT R X:DTIME G ERR:X="" G:X'["$$RX" SINGLE I X'[RX G SINGLE
|
|
S1 S REC1=$P(X,"|",2)
|
|
S2 U PSXT R X:DTIME G END:X=""
|
|
I $G(X)["$$ZX,"&($D(REC1)) S REC2=$P(X,"|",2) D RX^PSXARC2 K REC1,REC2 G S2
|
|
I $G(X)["$$LOT" S LOT=$P(X,"|",2) D LOT^PSXARC2 K LOT G S2
|
|
G END
|
|
ERR U IO(0) W !,"Rx not found. Please make sure the number is correct."
|
|
D END G PSXARPT
|
|
;
|
|
END I $G(PSXP)'=IO(0),($G(PSXERR)'=1) U PSXP W @PSXPIOF
|
|
D ^%ZISC
|
|
S DEV="" F S DEV=$O(IO(1,DEV)) Q:($G(DEV)'>0) S IOP=DEV D ^%ZIS,^%ZISC
|
|
D HOME^%ZIS
|
|
K PSXT,PSXP,RX,LOT,X,PSXEOT,PSXBATCH,REC,REC1,COM,LBL,ACK,XX,ZCT,PSXTAPE
|
|
K ZQ,ZQ1,PSXAM,PSXPIOF,PSXPIOST,PSXRPT,PSXTBS,PSXTIOF,PSXTNO,PSXTPAR,XZ
|
|
K Y,LBLCT,COMCT,C,ZPC,POP,%MT,DIROUT,DIRUT,DTOUT,DUOUT,PSXERR,RXX,XNEW
|
|
Q
|
|
DUMP ; DUMPS CONTENTS OF TAPE - NO FORMATTING
|
|
PQ 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
|
|
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 !!
|
|
I '$D(%MT("REW")) X ^%ZOSF("MAGTAPE")
|
|
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
|
|
STOP D ^%ZISC
|
|
K PSXAT,PSXACPF,PSXACPL,PSXAP,PSXACPM,PSXATNM,ZAL
|
|
Q
|