| [613] | 1 | DVBACPPB ;ALB/DW - Print Blank C&P Worksheets ; 8/27/1999
|
|---|
| 2 | ;;2.7;AMIE;**30**;Apr 10, 1995
|
|---|
| 3 | ;
|
|---|
| 4 | ;
|
|---|
| 5 | EN ;Entry point of the routine.
|
|---|
| 6 | N X,Y,CPNO,HD7,HD8,HD9,HD91,LX,LY,PG,DTOUT
|
|---|
| 7 | D HOME^%ZIS
|
|---|
| 8 | D SELECT
|
|---|
| 9 | I X="^"!(X="") W @IOF Q
|
|---|
| 10 | I $D(DTOUT) W *7 W @IOF Q
|
|---|
| 11 | S CPNO=+Y
|
|---|
| 12 | D PRINT
|
|---|
| 13 | D EXIT
|
|---|
| 14 | W @IOF
|
|---|
| 15 | Q
|
|---|
| 16 | ;
|
|---|
| 17 | SELECT ;Select C&P worksheet to print.
|
|---|
| 18 | N DIC
|
|---|
| 19 | S DIC="^DVB(396.6,",DIC(0)="AEQM",DIC("A")="Select C&P worksheet to print: "
|
|---|
| 20 | S DIC("S")="I $P($G(^DVB(396.6,Y,0)),U,5)=""A"""
|
|---|
| 21 | D ^DIC
|
|---|
| 22 | Q
|
|---|
| 23 | ;
|
|---|
| 24 | PRINT ;Select device to print the chosen C&P worksheet.
|
|---|
| 25 | W !!,"** Worksheets should be sent to a printer. **",!!
|
|---|
| 26 | N CODE,NAME,SSN,CNUM
|
|---|
| 27 | N POP,ZTSAVE,TSK,%ZIS,ZTRTN,ZTDESC,ZTSK
|
|---|
| 28 | S %ZIS="QM" D ^%ZIS Q:POP
|
|---|
| 29 | I $D(IO("Q")) D Q
|
|---|
| 30 | . S ZTRTN="WRITER^DVBACPPB",ZTDESC="DVBA Print blank C&P worksheets."
|
|---|
| 31 | . S ZTSAVE("CPNO")=""
|
|---|
| 32 | . D ^%ZTLOAD
|
|---|
| 33 | . S TSK=$S($D(ZTSK)=0:"C",1:"Y")
|
|---|
| 34 | . I TSK="Y" W !!,"Task queued! Task number: ",ZTSK
|
|---|
| 35 | . D HOME^%ZIS
|
|---|
| 36 | I '$D(IO("Q")) D WRITER
|
|---|
| 37 | Q
|
|---|
| 38 | ;
|
|---|
| 39 | WRITER ;Print out the chosen worksheet.
|
|---|
| 40 | U IO
|
|---|
| 41 | I $E(IOST,1,2)="C-" W @IOF
|
|---|
| 42 | S CODE=$P($G(^DVB(396.6,CPNO,0)),U,4) I $G(CODE)="" Q
|
|---|
| 43 | S (NAME,SSN,CNUM)=""
|
|---|
| 44 | S CODE="^"_CODE
|
|---|
| 45 | D @CODE
|
|---|
| 46 | D ^%ZISC
|
|---|
| 47 | Q
|
|---|
| 48 | ;
|
|---|
| 49 | EXIT ;Clean up variables upon exit.
|
|---|
| 50 | S:$D(ZTQUEUED) ZTREQ="@"
|
|---|
| 51 | Q
|
|---|
| 52 | ;
|
|---|
