ACDRR3P.m

ACDRR3P ;IHS/ADC/EDE/KML - PRINT REPORT;

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

 ;

START ;

 U IO

 D HEAD

 D BODY

 K ^TMP("ACDRR1",ACDJOB,ACDBTH)

 Q

 ;

HEAD ; WRITE HEADER

 I '$D(ZTQUEUED),'$D(IO("S")),$E(IOST,1,2)="C-" W @IOF

 W !,$$CTR^ACD("CDMIS PATIENT OUTCOME STAGE REPORT",80),!!

 W "Run at ",ACDSITE," for ",$$USR^ACD()," on ",$$FMTE^XLFDT(DT),!

 W "for date range ",$$FMTE^XLFDT(ACDDTLO)," through ",$$FMTE^XLFDT(ACDDTHI),!

 W $$REPEAT^XLFSTR("=",80),!!

 Q

 ;

BODY ; WRITE BODY OF REPORT

 W "PATIENT: ",ACDDFN,!!

 W "C1 = ALC/SUB STAGE",!

 W "C2 = PHYSICAL STAGE",!

 W "C3 = EMOTIONL STAGE",!

 W "C4 = SOCIAL STAGE",!

 W "C5 = CUL/SPIRIT STAGE",!

 W "C6 = BEHAVIORAL STAGE",!

 W "C7 = VOC/ED STAGE",!!

 W ?10,"C",?20,"C",?30,"C",?40,"C",?50,"C",?60,"C",?70,"C",!

 W ?10,"1",?20,"2",?30,"3",?40,"4",?50,"5",?60,"6",?70,"7",!!

 S ACDVDATE=0

 F  S ACDVDATE=$O(^TMP("ACDRR3",ACDJOB,ACDBTH,"V",ACDVDATE)) Q:ACDVDATE=""  D  Q:ACDQ

 .  S ACDVCNT=0

 .  F  S ACDVCNT=$O(^TMP("ACDRR3",ACDJOB,ACDBTH,"V",ACDVDATE,ACDVCNT)) Q:ACDVCNT=""  D  Q:ACDQ

 ..  W ACDVDATE

 ..  F ACDCOL=1:1:7 D

 ...  W ?(ACDCOL*10),^TMP("ACDRR3",ACDJOB,ACDBTH,"V",ACDVDATE,ACDVCNT,"COL",ACDCOL)

 ...  Q

 ..  W !

 ..  Q

 .  Q

 Q

ACDRR3P   ;IHS/ADC/EDE/KML - PRINT REPORT;

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

 +2       ;

START     ;

 +1        USE IO

 +2        DO HEAD

 +3        DO BODY

 +4        KILL ^TMP("ACDRR1",ACDJOB,ACDBTH)

 +5        QUIT 

 +6       ;

HEAD      ; WRITE HEADER

 +1        IF '$DATA(ZTQUEUED)

               IF '$DATA(IO("S"))

                   IF $EXTRACT(IOST,1,2)="C-"

                       WRITE @IOF

 +2        WRITE !,$$CTR^ACD("CDMIS PATIENT OUTCOME STAGE REPORT",80),!!

 +3        WRITE "Run at ",ACDSITE," for ",$$USR^ACD()," on ",$$FMTE^XLFDT(DT),!

 +4        WRITE "for date range ",$$FMTE^XLFDT(ACDDTLO)," through ",$$FMTE^XLFDT(ACDDTHI),!

 +5        WRITE $$REPEAT^XLFSTR("=",80),!!

 +6        QUIT 

 +7       ;

BODY      ; WRITE BODY OF REPORT

 +1        WRITE "PATIENT: ",ACDDFN,!!

 +2        WRITE "C1 = ALC/SUB STAGE",!

 +3        WRITE "C2 = PHYSICAL STAGE",!

 +4        WRITE "C3 = EMOTIONL STAGE",!

 +5        WRITE "C4 = SOCIAL STAGE",!

 +6        WRITE "C5 = CUL/SPIRIT STAGE",!

 +7        WRITE "C6 = BEHAVIORAL STAGE",!

 +8        WRITE "C7 = VOC/ED STAGE",!!

 +9        WRITE ?10,"C",?20,"C",?30,"C",?40,"C",?50,"C",?60,"C",?70,"C",!

 +10       WRITE ?10,"1",?20,"2",?30,"3",?40,"4",?50,"5",?60,"6",?70,"7",!!

 +11       SET ACDVDATE=0

 +12       FOR 

               SET ACDVDATE=$ORDER(^TMP("ACDRR3",ACDJOB,ACDBTH,"V",ACDVDATE))

               IF ACDVDATE=""

                   QUIT 

               Begin DoDot:1

 +13               SET ACDVCNT=0

 +14               FOR 

                       SET ACDVCNT=$ORDER(^TMP("ACDRR3",ACDJOB,ACDBTH,"V",ACDVDATE,ACDVCNT))

                       IF ACDVCNT=""

                           QUIT 

                       Begin DoDot:2

 +15                       WRITE ACDVDATE

 +16                       FOR ACDCOL=1:1:7

                               Begin DoDot:3

 +17                               WRITE ?(ACDCOL*10),^TMP("ACDRR3",ACDJOB,ACDBTH,"V",ACDVDATE,ACDVCNT,"COL",ACDCOL)

 +18                               QUIT 

                               End DoDot:3

 +19                       WRITE !

 +20                       QUIT 

                       End DoDot:2

                       IF ACDQ

                           QUIT 

 +21               QUIT 

               End DoDot:1

               IF ACDQ

                   QUIT 

 +22       QUIT