ACDPRGT.m

ACDPRGT ;IHS/ADC/EDE/KML - IHS-SMBD/MLQ PRINT ALL PROGRAM REPORTS;

 ;;4.1;CHEMICAL DEPENDENCY MIS;;MAY 11, 1998

EN ;

 Q  ;***** NOT USED ***** NOV 1995 + I deleted all the print templates

 K %ZIS,IOP,IO("Q") S %ZIS="QM" D ^%ZIS I POP W !,"No device selected or report queued." G K

 S ACDEV=ION I $D(IO("Q")) K IO("Q") S ZTIO=ION,ACDEV=ION K ZTSAVE,ZTDTH,ZTSK S ZTRTN="Q^ACDPRGT",ZTSAVE("DUZ*")="",ZTSAVE("ACDEV")="",ZTDTH=$H D ^%ZTLOAD W !,"Queued" G K

Q ;EP TM

 S ACDP="PART" F ACD=0:1:13 S ACDTG=ACDP_ACD,L=0,DIC="^ACDF5PI(" D @ACDTG

 Q

PART0 ;

 S FLDS="[ACD R5-FL]",BY="[ACD R5-FL]"

 S IOP=ACDEV

 D EN1^DIP,^%ZISC Q

PART1 S FLDS="[ACD R5-SFF]",BY="[ACD R5-SFF]"

 S IOP=ACDEV

 D EN1^DIP,^%ZISC

 Q

PART2 S FLDS="[ACD R5-AIS]",BY=".01",FR=""

 S IOP=ACDEV

 D EN1^DIP,^%ZISC

 Q

PART3 S FLDS="[ACD R5-IPO]",BY=".01",FR=""

 S IOP=ACDEV

 D EN1^DIP,^%ZISC

 Q

PART4 S FLDS="[ACD R5-NP]",BY=".01",FR=""

 S IOP=ACDEV

 D EN1^DIP,^%ZISC

 Q

PART5 S FLDS="[ACD R5-OPC]",BY=".01",FR=""

 S IOP=ACDEV

 D EN1^DIP,^%ZISC

 Q

PART6 S FLDS="[ACD R5-PFP]",BY=".01",FR=""

 S IOP=ACDEV

 D EN1^DIP,^%ZISC

 Q

PART7 S FLDS="[ACD R5-SEL]",BY=".01",FR=""

 S IOP=ACDEV

 D EN1^DIP,^%ZISC

 Q

PART8 S FLDS="[ACD R5-SCT1]",BY=".01",FR=""

 S IOP=ACDEV

 D EN1^DIP,^%ZISC

 Q

PART9 S FLDS="[ACD R5-SCT2]",BY=".01",FR=""

 S IOP=ACDEV

 D EN1^DIP,^%ZISC

 Q

PART10 S FLDS="[ACD R5-SPJ1]",BY=".01",FR=""

 S IOP=ACDEV

 D EN1^DIP,^%ZISC

 Q

PART11 S FLDS="[ACD R5-SPJ2]",BY=".01",FR=""

 S IOP=ACDEV

 D EN1^DIP,^%ZISC

 Q

PART12 S FLDS="[ACD R5-SPT]",BY=".01",FR=""

 S IOP=ACDEV

 D EN1^DIP,^%ZISC

 Q

PART13 S FLDS="[ACD R5-DIR]",BY="[ACD R5-PRPGBRK]"

 S IOP=ACDEV

 D EN1^DIP,^%ZISC

 Q

K ;

 K ACDEV

 Q

ACDPRGT   ;IHS/ADC/EDE/KML - IHS-SMBD/MLQ PRINT ALL PROGRAM REPORTS;

 +1       ;;4.1;CHEMICAL DEPENDENCY MIS;;MAY 11, 1998

EN        ;

 +1       ;***** NOT USED ***** NOV 1995 + I deleted all the print templates

           QUIT 

 +2        KILL %ZIS,IOP,IO("Q")

           SET %ZIS="QM"

           DO ^%ZIS

           IF POP

               WRITE !,"No device selected or report queued."

               GOTO K

 +3        SET ACDEV=ION

           IF $DATA(IO("Q"))

               KILL IO("Q")

               SET ZTIO=ION

               SET ACDEV=ION

               KILL ZTSAVE,ZTDTH,ZTSK

               SET ZTRTN="Q^ACDPRGT"

               SET ZTSAVE("DUZ*")=""

               SET ZTSAVE("ACDEV")=""

               SET ZTDTH=$HOROLOG

               DO ^%ZTLOAD

               WRITE !,"Queued"

               GOTO K

Q         ;EP TM

 +1        SET ACDP="PART"

           FOR ACD=0:1:13

               SET ACDTG=ACDP_ACD

               SET L=0

               SET DIC="^ACDF5PI("

               DO @ACDTG

 +2        QUIT 

PART0     ;

 +1        SET FLDS="[ACD R5-FL]"

           SET BY="[ACD R5-FL]"

 +2        SET IOP=ACDEV

 +3        DO EN1^DIP

           DO ^%ZISC

           QUIT 

PART1      SET FLDS="[ACD R5-SFF]"

           SET BY="[ACD R5-SFF]"

 +1        SET IOP=ACDEV

 +2        DO EN1^DIP

           DO ^%ZISC

 +3        QUIT 

PART2      SET FLDS="[ACD R5-AIS]"

           SET BY=".01"

           SET FR=""

 +1        SET IOP=ACDEV

 +2        DO EN1^DIP

           DO ^%ZISC

 +3        QUIT 

PART3      SET FLDS="[ACD R5-IPO]"

           SET BY=".01"

           SET FR=""

 +1        SET IOP=ACDEV

 +2        DO EN1^DIP

           DO ^%ZISC

 +3        QUIT 

PART4      SET FLDS="[ACD R5-NP]"

           SET BY=".01"

           SET FR=""

 +1        SET IOP=ACDEV

 +2        DO EN1^DIP

           DO ^%ZISC

 +3        QUIT 

PART5      SET FLDS="[ACD R5-OPC]"

           SET BY=".01"

           SET FR=""

 +1        SET IOP=ACDEV

 +2        DO EN1^DIP

           DO ^%ZISC

 +3        QUIT 

PART6      SET FLDS="[ACD R5-PFP]"

           SET BY=".01"

           SET FR=""

 +1        SET IOP=ACDEV

 +2        DO EN1^DIP

           DO ^%ZISC

 +3        QUIT 

PART7      SET FLDS="[ACD R5-SEL]"

           SET BY=".01"

           SET FR=""

 +1        SET IOP=ACDEV

 +2        DO EN1^DIP

           DO ^%ZISC

 +3        QUIT 

PART8      SET FLDS="[ACD R5-SCT1]"

           SET BY=".01"

           SET FR=""

 +1        SET IOP=ACDEV

 +2        DO EN1^DIP

           DO ^%ZISC

 +3        QUIT 

PART9      SET FLDS="[ACD R5-SCT2]"

           SET BY=".01"

           SET FR=""

 +1        SET IOP=ACDEV

 +2        DO EN1^DIP

           DO ^%ZISC

 +3        QUIT 

PART10     SET FLDS="[ACD R5-SPJ1]"

           SET BY=".01"

           SET FR=""

 +1        SET IOP=ACDEV

 +2        DO EN1^DIP

           DO ^%ZISC

 +3        QUIT 

PART11     SET FLDS="[ACD R5-SPJ2]"

           SET BY=".01"

           SET FR=""

 +1        SET IOP=ACDEV

 +2        DO EN1^DIP

           DO ^%ZISC

 +3        QUIT 

PART12     SET FLDS="[ACD R5-SPT]"

           SET BY=".01"

           SET FR=""

 +1        SET IOP=ACDEV

 +2        DO EN1^DIP

           DO ^%ZISC

 +3        QUIT 

PART13     SET FLDS="[ACD R5-DIR]"

           SET BY="[ACD R5-PRPGBRK]"

 +1        SET IOP=ACDEV

 +2        DO EN1^DIP

           DO ^%ZISC

 +3        QUIT 

K         ;

 +1        KILL ACDEV

 +2        QUIT