- ACDWRP15 ;IHS/ADC/EDE/KML - REPORT GENERATOR;
- ;;4.1;CHEMICAL DEPENDENCY MIS;;MAY 11, 1998
- ;Reports 14,62
- S (ACDIFCNT,ACDSCNT)=0
- I '$D(^TMP("ACD",ACDJOB,ACDBT,ACDTGSUB,"VAL")) D ^ACDWK Q
- 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)
- I $D(DIRUT) D ^ACDWK Q
- W !!,"CLIENTS WITH NO DIFFERENCE REASON = ",ACDSCNT
- W !!,"CLIENTS WITH A DIFFERENCE REASON = ",ACDIFCNT
- D ^ACDWK Q
- P1 ;
- S ACDP2="" F S ACDP2=$O(^TMP("ACD",ACDJOB,ACDBT,ACDTGSUB,"VAL",ACDP1,ACDP2)) Q:ACDP2="" W ?26,$E(ACDP2,1,24) D P2 Q:$D(DIRUT)
- Q
- P2 ;
- S ACDP3="" F S ACDP3=$O(^TMP("ACD",ACDJOB,ACDBT,ACDTGSUB,"VAL",ACDP1,ACDP2,ACDP3)) Q:ACDP3="" S ACDN0=^(ACDP3) W ?52,$E(ACDP3,1,19),?75,$J(ACDN0,4),! D F Q:$D(DIRUT) S:ACDP1=ACDP2 ACDSCNT=ACDSCNT+ACDN0 S:ACDP1'=ACDP2 ACDIFCNT=ACDIFCNT+ACDN0
- Q
- F ;Form feed
- I $Y+4>IOSL D F^ACDWUTL D:'$D(DIRUT) C
- Q
- C ;Column
- W !!,ACDC(1),?26,ACDC(2),?52,ACDC(3),?72,ACDC(4),!,ACDH(1),!
- ACDWRP15 ;IHS/ADC/EDE/KML - REPORT GENERATOR;
- +1 ;;4.1;CHEMICAL DEPENDENCY MIS;;MAY 11, 1998
- +2 ;Reports 14,62
- +3 SET (ACDIFCNT,ACDSCNT)=0
- +4 IF '$DATA(^TMP("ACD",ACDJOB,ACDBT,ACDTGSUB,"VAL"))
- DO ^ACDWK
- QUIT
- +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 IF $DATA(DIRUT)
- DO ^ACDWK
- QUIT
- +7 WRITE !!,"CLIENTS WITH NO DIFFERENCE REASON = ",ACDSCNT
- +8 WRITE !!,"CLIENTS WITH A DIFFERENCE REASON = ",ACDIFCNT
- +9 DO ^ACDWK
- QUIT
- P1 ;
- +1 SET ACDP2=""
- FOR
- SET ACDP2=$ORDER(^TMP("ACD",ACDJOB,ACDBT,ACDTGSUB,"VAL",ACDP1,ACDP2))
- IF ACDP2=""
- QUIT
- WRITE ?26,$EXTRACT(ACDP2,1,24)
- DO P2
- IF $DATA(DIRUT)
- QUIT
- +2 QUIT
- P2 ;
- +1 SET ACDP3=""
- FOR
- SET ACDP3=$ORDER(^TMP("ACD",ACDJOB,ACDBT,ACDTGSUB,"VAL",ACDP1,ACDP2,ACDP3))
- IF ACDP3=""
- QUIT
- SET ACDN0=^(ACDP3)
- WRITE ?52,$EXTRACT(ACDP3,1,19),?75,$JUSTIFY(ACDN0,4),!
- DO F
- IF $DATA(DIRUT)
- QUIT
- IF ACDP1=ACDP2
- SET ACDSCNT=ACDSCNT+ACDN0
- IF ACDP1'=ACDP2
- SET ACDIFCNT=ACDIFCNT+ACDN0
- +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),?52,ACDC(3),?72,ACDC(4),!,ACDH(1),!
