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
