ACDWRP91.m

ACDWRP91 ;IHS/ADC/EDE/KML - REPORT GENERATOR; 

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

 ;Report 1

 I '$D(^TMP("ACD",ACDJOB,ACDBT,ACDTGSUB,"VAL")) D ^ACDWK Q

 S (ACDGTOT,ACDGTOT1)=0

 D C S ACDP1="" F  D F Q:$D(DIRUT)  S ACDP1=$O(^TMP("ACD",ACDJOB,ACDBT,ACDTGSUB,"VAL",ACDP1)) Q:ACDP1=""  W !,$E(ACDP1,1,24) D P1 Q:$D(DIRUT)

 D ^ACDWK Q

P1 ;

 S ACDP2="" F  D F Q:$D(DIRUT)  S ACDP2=$O(^TMP("ACD",ACDJOB,ACDBT,ACDTGSUB,"VAL",ACDP1,ACDP2)) Q:ACDP2=""  W ?26,$E(ACDP2) D P2 Q:$D(DIRUT)

 Q

P2 ;

 S ACDP3="" F  D F Q:$D(DIRUT)  S ACDP3=$O(^TMP("ACD",ACDJOB,ACDBT,ACDTGSUB,"VAL",ACDP1,ACDP2,ACDP3)) Q:ACDP3=""   W ?31,ACDP3 D P3 Q:$D(DIRUT)

 Q

P3 ;

 S ACDP4="" F  D F Q:$D(DIRUT)  S ACDP4=$O(^TMP("ACD",ACDJOB,ACDBT,ACDTGSUB,"VAL",ACDP1,ACDP2,ACDP3,ACDP4)) Q:ACDP4=""   W ?41,ACDP4 D P4 Q:$D(DIRUT)

 Q

 ;

P4 ;

 S (ACDSTOT,ACDSTOT1)=0 F ACDP5=0:0 D F Q:$D(DIRUT)  S ACDP5=$O(^TMP("ACD",ACDJOB,ACDBT,ACDTGSUB,"VAL",ACDP1,ACDP2,ACDP3,ACDP4,ACDP5)) Q:'ACDP5  D P5 Q:$D(DIRUT)

 Q:$D(DIRUT)

 W ?53,ACDSTOT,?70,ACDSTOT1,!

 Q

P5 ;

 S ACDSTOT=ACDSTOT+1,ACDSTOT1=ACDSTOT1+^TMP("ACD",ACDJOB,ACDBT,ACDTGSUB,"VAL",ACDP1,ACDP2,ACDP3,ACDP4,ACDP5)

 Q

F ;Form feed

 I $Y+4>IOSL D F^ACDWUTL D:'$D(DIRUT) C

 Q

C ;Column

 W !!,ACDC(1),?26,ACDC(2),?31,ACDC(3),?41,ACDC(4),?53,ACDC(5),?70,ACDC(6),!,ACDH(1),!

 Q

ACDWRP91  ;IHS/ADC/EDE/KML - REPORT GENERATOR; 

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

 +2       ;Report 1

 +3        IF '$DATA(^TMP("ACD",ACDJOB,ACDBT,ACDTGSUB,"VAL"))

               DO ^ACDWK

               QUIT 

 +4        SET (ACDGTOT,ACDGTOT1)=0

 +5        DO C

           SET ACDP1=""

           FOR 

               DO F

               IF $DATA(DIRUT)

                   QUIT 

               SET ACDP1=$ORDER(^TMP("ACD",ACDJOB,ACDBT,ACDTGSUB,"VAL",ACDP1))

               IF ACDP1=""

                   QUIT 

               WRITE !,$EXTRACT(ACDP1,1,24)

               DO P1

               IF $DATA(DIRUT)

                   QUIT 

 +6        DO ^ACDWK

           QUIT 

P1        ;

 +1        SET ACDP2=""

           FOR 

               DO F

               IF $DATA(DIRUT)

                   QUIT 

               SET ACDP2=$ORDER(^TMP("ACD",ACDJOB,ACDBT,ACDTGSUB,"VAL",ACDP1,ACDP2))

               IF ACDP2=""

                   QUIT 

               WRITE ?26,$EXTRACT(ACDP2)

               DO P2

               IF $DATA(DIRUT)

                   QUIT 

 +2        QUIT 

P2        ;

 +1        SET ACDP3=""

           FOR 

               DO F

               IF $DATA(DIRUT)

                   QUIT 

               SET ACDP3=$ORDER(^TMP("ACD",ACDJOB,ACDBT,ACDTGSUB,"VAL",ACDP1,ACDP2,ACDP3))

               IF ACDP3=""

                   QUIT 

               WRITE ?31,ACDP3

               DO P3

               IF $DATA(DIRUT)

                   QUIT 

 +2        QUIT 

P3        ;

 +1        SET ACDP4=""

           FOR 

               DO F

               IF $DATA(DIRUT)

                   QUIT 

               SET ACDP4=$ORDER(^TMP("ACD",ACDJOB,ACDBT,ACDTGSUB,"VAL",ACDP1,ACDP2,ACDP3,ACDP4))

               IF ACDP4=""

                   QUIT 

               WRITE ?41,ACDP4

               DO P4

               IF $DATA(DIRUT)

                   QUIT 

 +2        QUIT 

 +3       ;

P4        ;

 +1        SET (ACDSTOT,ACDSTOT1)=0

           FOR ACDP5=0:0

               DO F

               IF $DATA(DIRUT)

                   QUIT 

               SET ACDP5=$ORDER(^TMP("ACD",ACDJOB,ACDBT,ACDTGSUB,"VAL",ACDP1,ACDP2,ACDP3,ACDP4,ACDP5))

               IF 'ACDP5

                   QUIT 

               DO P5

               IF $DATA(DIRUT)

                   QUIT 

 +2        IF $DATA(DIRUT)

               QUIT 

 +3        WRITE ?53,ACDSTOT,?70,ACDSTOT1,!

 +4        QUIT 

P5        ;

 +1        SET ACDSTOT=ACDSTOT+1

           SET ACDSTOT1=ACDSTOT1+^TMP("ACD",ACDJOB,ACDBT,ACDTGSUB,"VAL",ACDP1,ACDP2,ACDP3,ACDP4,ACDP5)

 +2        QUIT 

F         ;Form feed

 +1        IF $Y+4>IOSL

               DO F^ACDWUTL

               IF '$DATA(DIRUT)

                   DO C

 +2        QUIT 

C         ;Column

 +1        WRITE !!,ACDC(1),?26,ACDC(2),?31,ACDC(3),?41,ACDC(4),?53,ACDC(5),?70,ACDC(6),!,ACDH(1),!

 +2        QUIT