DVBACPPB.m

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 ---DVBACPPB   1253     printed  Apr 09, 2024@20:50:43                                                                                                                                                                                                    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       ;