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
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDVBACPPB 1253 printed Dec 13, 2024@01:40:58 Page 2
DVBACPPB ;ALB/DW - Print Blank C&P Worksheets ; 8/27/1999
+1 ;;2.7;AMIE;**30**;Apr 10, 1995
+2 ;
+3 ;
EN ;Entry point of the routine.
+1 NEW X,Y,CPNO,HD7,HD8,HD9,HD91,LX,LY,PG,DTOUT
+2 DO HOME^%ZIS
+3 DO SELECT
+4 IF X="^"!(X="")
WRITE @IOF
QUIT
+5 IF $DATA(DTOUT)
WRITE *7
WRITE @IOF
QUIT
+6 SET CPNO=+Y
+7 DO PRINT
+8 DO EXIT
+9 WRITE @IOF
+10 QUIT
+11 ;
SELECT ;Select C&P worksheet to print.
+1 NEW DIC
+2 SET DIC="^DVB(396.6,"
SET DIC(0)="AEQM"
SET DIC("A")="Select C&P worksheet to print: "
+3 SET DIC("S")="I $P($G(^DVB(396.6,Y,0)),U,5)=""A"""
+4 DO ^DIC
+5 QUIT
+6 ;
PRINT ;Select device to print the chosen C&P worksheet.
+1 WRITE !!,"** Worksheets should be sent to a printer. **",!!
+2 NEW CODE,NAME,SSN,CNUM
+3 NEW POP,ZTSAVE,TSK,%ZIS,ZTRTN,ZTDESC,ZTSK
+4 SET %ZIS="QM"
DO ^%ZIS
if POP
QUIT
+5 IF $DATA(IO("Q"))
Begin DoDot:1
+6 SET ZTRTN="WRITER^DVBACPPB"
SET ZTDESC="DVBA Print blank C&P worksheets."
+7 SET ZTSAVE("CPNO")=""
+8 DO ^%ZTLOAD
+9 SET TSK=$SELECT($DATA(ZTSK)=0:"C",1:"Y")
+10 IF TSK="Y"
WRITE !!,"Task queued! Task number: ",ZTSK
+11 DO HOME^%ZIS
End DoDot:1
QUIT
+12 IF '$DATA(IO("Q"))
DO WRITER
+13 QUIT
+14 ;
WRITER ;Print out the chosen worksheet.
+1 USE IO
+2 IF $EXTRACT(IOST,1,2)="C-"
WRITE @IOF
+3 SET CODE=$PIECE($GET(^DVB(396.6,CPNO,0)),U,4)
IF $GET(CODE)=""
QUIT
+4 SET (NAME,SSN,CNUM)=""
+5 SET CODE="^"_CODE
+6 DO @CODE
+7 DO ^%ZISC
+8 QUIT
+9 ;
EXIT ;Clean up variables upon exit.
+1 if $DATA(ZTQUEUED)
SET ZTREQ="@"
+2 QUIT
+3 ;
