ACDRR1P.m

ACDRR1P ;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 PROBLEM/DRUG SUMMARY 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

 ; ******* DO NOT CHANGE THE VALUE OF X ********

 S ACDQ=0

 S X=^TMP("ACDRR1",ACDJOB,ACDBT,"SEEN")

 D ALCDRUG^ACDRR1PB

 Q:ACDQ

 D DAYSCS^ACDRR1PB

 Q:ACDQ

 D TOBACCO^ACDRR1PB

 Q:ACDQ

 D PRIPROB^ACDRR1PB

 Q:ACDQ

 D PROBLEM^ACDRR1PB

 Q:ACDQ

 D DRUGUSED^ACDRR1PB

 Q:ACDQ

 D DRUGCMB^ACDRR1PB

 Q:ACDQ

 D TRIBE^ACDRR1PC

 Q:ACDQ

 D LOS^ACDRR1PC

 Q:ACDQ

 D PAUSE^ACDDEU

 Q

ACDRR1P   ;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 PROBLEM/DRUG SUMMARY 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       ; ******* DO NOT CHANGE THE VALUE OF X ********

 +2        SET ACDQ=0

 +3        SET X=^TMP("ACDRR1",ACDJOB,ACDBT,"SEEN")

 +4        DO ALCDRUG^ACDRR1PB

 +5        IF ACDQ

               QUIT 

 +6        DO DAYSCS^ACDRR1PB

 +7        IF ACDQ

               QUIT 

 +8        DO TOBACCO^ACDRR1PB

 +9        IF ACDQ

               QUIT 

 +10       DO PRIPROB^ACDRR1PB

 +11       IF ACDQ

               QUIT 

 +12       DO PROBLEM^ACDRR1PB

 +13       IF ACDQ

               QUIT 

 +14       DO DRUGUSED^ACDRR1PB

 +15       IF ACDQ

               QUIT 

 +16       DO DRUGCMB^ACDRR1PB

 +17       IF ACDQ

               QUIT 

 +18       DO TRIBE^ACDRR1PC

 +19       IF ACDQ

               QUIT 

 +20       DO LOS^ACDRR1PC

 +21       IF ACDQ

               QUIT 

 +22       DO PAUSE^ACDDEU

 +23       QUIT