ACDWRP25.m

ACDWRP25 ;IHS/ADC/EDE/KML - OUTPUT GENERATOR;

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

 ;Reports 301,302

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

 S (ACDVCNT,ACDNCNT)=0

P1 ;

 D C

 S ACDP1=""

 F  D F Q:$D(DIRUT)  S ACDP1=$O(^TMP("ACD",ACDJOB,ACDBT,ACDTGSUB,"VAL",ACDP1)) Q:ACDP1=""  D  Q:$D(DIRUT)

 . W !,$E(ACDP1,1,22)

 . S ACDP2=""

 . F  D F Q:$D(DIRUT)  S ACDP2=$O(^TMP("ACD",ACDJOB,ACDBT,ACDTGSUB,"VAL",ACDP1,ACDP2)) Q:ACDP2=""  S ACDN0=^(ACDP2) D P2 Q:$D(DIRUT)

 W:'$D(DIRUT) !?49,"=====",?60,"=====",!?49,ACDNCNT,?60,ACDVCNT

 D ^ACDWK

 Q

P2 ;

 S ACDVIS=$P(ACDN0,U),ACDNUMR=$P(ACDN0,U,2)

 W ?24,$E(ACDP2,1,22),?49,ACDNUMR,?60,ACDVIS,?72,$J(ACDNUMR/ACDVIS,7,2),!

 S ACDNCNT=ACDNCNT+ACDNUMR,ACDVCNT=ACDVCNT+ACDVIS

 Q

F ;Form feed

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

 Q

C ;Column

 W !,ACDC(1),?24,ACDC(2),?49,ACDC(3),?60,ACDC(4),?71,ACDC(5),!,ACDH(1),!

 Q

ACDWRP25  ;IHS/ADC/EDE/KML - OUTPUT GENERATOR;

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

 +2       ;Reports 301,302

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

               DO ^ACDWK

               QUIT 

 +4        SET (ACDVCNT,ACDNCNT)=0

P1        ;

 +1        DO C

 +2        SET ACDP1=""

 +3        FOR 

               DO F

               IF $DATA(DIRUT)

                   QUIT 

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

               IF ACDP1=""

                   QUIT 

               Begin DoDot:1

 +4                WRITE !,$EXTRACT(ACDP1,1,22)

 +5                SET ACDP2=""

 +6                FOR 

                       DO F

                       IF $DATA(DIRUT)

                           QUIT 

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

                       IF ACDP2=""

                           QUIT 

                       SET ACDN0=^(ACDP2)

                       DO P2

                       IF $DATA(DIRUT)

                           QUIT 

               End DoDot:1

               IF $DATA(DIRUT)

                   QUIT 

 +7        IF '$DATA(DIRUT)

               WRITE !?49,"=====",?60,"=====",!?49,ACDNCNT,?60,ACDVCNT

 +8        DO ^ACDWK

 +9        QUIT 

P2        ;

 +1        SET ACDVIS=$PIECE(ACDN0,U)

           SET ACDNUMR=$PIECE(ACDN0,U,2)

 +2        WRITE ?24,$EXTRACT(ACDP2,1,22),?49,ACDNUMR,?60,ACDVIS,?72,$JUSTIFY(ACDNUMR/ACDVIS,7,2),!

 +3        SET ACDNCNT=ACDNCNT+ACDNUMR

           SET ACDVCNT=ACDVCNT+ACDVIS

 +4        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),?24,ACDC(2),?49,ACDC(3),?60,ACDC(4),?71,ACDC(5),!,ACDH(1),!

 +2        QUIT