ACDRR3.m

ACDRR3 ;IHS/ADC/EDE/KML - OUTCOME REPORT (STAGE);

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

 ;

 ; This routine prints a patient outcome report listing the

 ; stages over time.

 ;

START ;

 D INIT

 Q:ACDQ

 D DBQUE

 Q

 ;

INIT ;

 S ACDQ=1

 W !,"This routine prints a patient outcome report for a specified time frame",!

 D GETDTR^ACDDEU ;              get acddtlo & acddthi

 Q:ACDQ

 D GETPAT^ACDDEGP ;             get patient

 Q:ACDQ

 S ACDQ=0

 Q

 ;

DBQUE ; call to XBDBQUE

DEBUG D ^ACDRR3C,^ACDRR3P Q

 S ACDQ=1

 W ! S DIR(0)="S^P:PRINT Output;B:BROWSE Output on Screen",DIR("A")="Do you wish to",DIR("B")="P" K DA D ^DIR K DIR

 Q:$D(DIRUT)

 I Y="B" D BROWSE Q

 S XBRP="^ACDRR3P",XBRC="^ACDRR3C",XBRX="EOJ^ACDRR3",XBNS="ACD"

 D ^XBDBQUE

 Q

 ;

BROWSE ;

 S XBRP="VIEWR^XBLM(""^ACDRR3P"")"

 S XBRC="^ACDRR3C",XBRX="EOJ^ACDRR3",XBIOP=0

 D ^XBDBQUE

 Q

 ;

EOJ ; EP-CALLED BY XBDBQUE

 W:IOST["P-" @IOF

 ;K ^TMP("ACDRR3",ACDJOB,ACDBTH)

 K %,%1,%2,%3,%DT,F,M,V,W,X,Y,Z

 K ACDBT,ACDBTH,ACDDTHI,ACDDTLO,ACDET,ACDJOB

 Q

ACDRR3    ;IHS/ADC/EDE/KML - OUTCOME REPORT (STAGE);

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

 +2       ;

 +3       ; This routine prints a patient outcome report listing the

 +4       ; stages over time.

 +5       ;

START     ;

 +1        DO INIT

 +2        IF ACDQ

               QUIT 

 +3        DO DBQUE

 +4        QUIT 

 +5       ;

INIT      ;

 +1        SET ACDQ=1

 +2        WRITE !,"This routine prints a patient outcome report for a specified time frame",!

 +3       ;              get acddtlo & acddthi

           DO GETDTR^ACDDEU

 +4        IF ACDQ

               QUIT 

 +5       ;             get patient

           DO GETPAT^ACDDEGP

 +6        IF ACDQ

               QUIT 

 +7        SET ACDQ=0

 +8        QUIT 

 +9       ;

DBQUE     ; call to XBDBQUE

DEBUG      DO ^ACDRR3C

           DO ^ACDRR3P

           QUIT 

 +1        SET ACDQ=1

 +2        WRITE !

           SET DIR(0)="S^P:PRINT Output;B:BROWSE Output on Screen"

           SET DIR("A")="Do you wish to"

           SET DIR("B")="P"

           KILL DA

           DO ^DIR

           KILL DIR

 +3        IF $DATA(DIRUT)

               QUIT 

 +4        IF Y="B"

               DO BROWSE

               QUIT 

 +5        SET XBRP="^ACDRR3P"

           SET XBRC="^ACDRR3C"

           SET XBRX="EOJ^ACDRR3"

           SET XBNS="ACD"

 +6        DO ^XBDBQUE

 +7        QUIT 

 +8       ;

BROWSE    ;

 +1        SET XBRP="VIEWR^XBLM(""^ACDRR3P"")"

 +2        SET XBRC="^ACDRR3C"

           SET XBRX="EOJ^ACDRR3"

           SET XBIOP=0

 +3        DO ^XBDBQUE

 +4        QUIT 

 +5       ;

EOJ       ; EP-CALLED BY XBDBQUE

 +1        IF IOST["P-"

               WRITE @IOF

 +2       ;K ^TMP("ACDRR3",ACDJOB,ACDBTH)

 +3        KILL %,%1,%2,%3,%DT,F,M,V,W,X,Y,Z

 +4        KILL ACDBT,ACDBTH,ACDDTHI,ACDDTLO,ACDET,ACDJOB

 +5        QUIT