53 lines
1.2 KiB
Mathematica
53 lines
1.2 KiB
Mathematica
DVBACPPB ;ALB/DW - Print Blank C&P Worksheets ; 8/27/1999
|
|
;;2.7;AMIE;**30**;Apr 10, 1995
|
|
;
|
|
;
|
|
EN ;Entry point of the routine.
|
|
N X,Y,CPNO,HD7,HD8,HD9,HD91,LX,LY,PG,DTOUT
|
|
D HOME^%ZIS
|
|
D SELECT
|
|
I X="^"!(X="") W @IOF Q
|
|
I $D(DTOUT) W *7 W @IOF Q
|
|
S CPNO=+Y
|
|
D PRINT
|
|
D EXIT
|
|
W @IOF
|
|
Q
|
|
;
|
|
SELECT ;Select C&P worksheet to print.
|
|
N DIC
|
|
S DIC="^DVB(396.6,",DIC(0)="AEQM",DIC("A")="Select C&P worksheet to print: "
|
|
S DIC("S")="I $P($G(^DVB(396.6,Y,0)),U,5)=""A"""
|
|
D ^DIC
|
|
Q
|
|
;
|
|
PRINT ;Select device to print the chosen C&P worksheet.
|
|
W !!,"** Worksheets should be sent to a printer. **",!!
|
|
N CODE,NAME,SSN,CNUM
|
|
N POP,ZTSAVE,TSK,%ZIS,ZTRTN,ZTDESC,ZTSK
|
|
S %ZIS="QM" D ^%ZIS Q:POP
|
|
I $D(IO("Q")) D Q
|
|
. S ZTRTN="WRITER^DVBACPPB",ZTDESC="DVBA Print blank C&P worksheets."
|
|
. S ZTSAVE("CPNO")=""
|
|
. D ^%ZTLOAD
|
|
. S TSK=$S($D(ZTSK)=0:"C",1:"Y")
|
|
. I TSK="Y" W !!,"Task queued! Task number: ",ZTSK
|
|
. D HOME^%ZIS
|
|
I '$D(IO("Q")) D WRITER
|
|
Q
|
|
;
|
|
WRITER ;Print out the chosen worksheet.
|
|
U IO
|
|
I $E(IOST,1,2)="C-" W @IOF
|
|
S CODE=$P($G(^DVB(396.6,CPNO,0)),U,4) I $G(CODE)="" Q
|
|
S (NAME,SSN,CNUM)=""
|
|
S CODE="^"_CODE
|
|
D @CODE
|
|
D ^%ZISC
|
|
Q
|
|
;
|
|
EXIT ;Clean up variables upon exit.
|
|
S:$D(ZTQUEUED) ZTREQ="@"
|
|
Q
|
|
;
|