Routine: AMHRPEC

AMHRPEC ; IHS/CMI/LAB - ACTIVE CLIENT LIST ;

 ;;4.0;IHS BEHAVIORAL HEALTH;;MAY 14, 2010

START ;

 I '$D(IOF) D HOME^%ZIS

 W @(IOF),!!

 W "**********  DURATION OF CARE REPORT  **********",!!

 W "This report will produce a list of all closed cases in a date"

 W !,"range that you specify.  In order to be included in this report"

 W !,"the case must have both a case open and a case closed date."

 W !,"The duration of care is calculated by counting the number of days"

 W !,"from the case open date to the case closed date."

 W !!,"Cases may be selected based on Open date, Closed date or both."

 W !,"Only those cases falling within the specified time frame will be"

 W !,"counted."

 W !!

 I '$D(^AMHSITE(DUZ(2),16,DUZ)) D

 .W !,"This report will only include Cases on which you are the documented"

 .W !,"provider.",!!

 D DBHUSRP^AMHUTIL

 D XIT

DATES K AMHED,AMHBD

 K DIR W ! S DIR(0)="DO^::EXP",DIR("A")="Enter Beginning Date"

 D ^DIR G:Y<1 XIT S AMHBD=Y

 K DIR S DIR(0)="DO^:DT:EXP",DIR("A")="Enter Ending Date"

 D ^DIR G:Y<1 XIT  S AMHED=Y

 I AMHED<AMHBD D  G DATES

 . W !!,$C(7),"Sorry, Ending Date MUST not be earlier than Beginning Date."

 S AMHSD=$$FMADD^XLFDT(AMHBD,-1)_".9999"

WHICH ;

 S (AMHOPEN,AMHCLOSE)=""

 S DIR(0)="S^O:Cases OPENED in that Date Range;C:Cases CLOSED in that Date Range;B:Cases either opened or closed in that Date Range"

 S DIR("A")="Please Select which Dates should be Used",DIR("B")="B" KILL DA D ^DIR KILL DIR

 I $D(DIRUT) G DATES

 I Y="O" S AMHOPEN=1

 I Y="C" S AMHCLOSE=1

 I Y="B" S (AMHOPEN,AMHCLOSE)=1

PROG ;

 S AMHPROG=""

 S DIR(0)="S^O:ONE Program;A:ALL Programs",DIR("A")="Run the Report for which PROGRAM",DIR("B")="A" KILL DA D ^DIR KILL DIR

 G:$D(DIRUT) WHICH

 I Y="A" G PROV

 S DIR(0)="9002011.58,.03",DIR("A")="Which PROGRAM" KILL DA D ^DIR KILL DIR

 G:$D(DIRUT) PROG

 I X="" G PROG

 S AMHPROG=Y

PROV ;

W !

 S AMHPROV=""

 S DIR(0)="S^A:All Providers;O:One Provider",DIR("A")="Include cases opened by",DIR("B")="A" K DA D ^DIR K DIR

 G:$D(DIRUT) XIT

 I Y="A" G PAGE

 S DIC="^VA(200,",DIC(0)="AEMQ",DIC("A")="Which PROVIDER: " D ^DIC

 K DIC,DA

 I Y=-1 G PROV

 S AMHPROV=+Y

 G ZIS

PAGE ;

 S AMHNPAG=0,DIR(0)="Y",DIR("A")="Do you want each Provider on a separate page",DIR("B")="N" K DA D ^DIR K DIR

 G:$D(DIRUT) PROV

 S AMHNPAG=Y

ZIS ;

DEMO ;

 D DEMOCHK^AMHUTIL1(.AMHDEMO)

 I AMHDEMO=-1 G PROV

 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

 I $D(DIRUT) G XIT

 I $G(Y)="B" D BROWSE,XIT Q

 S XBRC="PROC^AMHRPEC",XBRP="PRINT^AMHRPEC",XBNS="AMH",XBRX="XIT^AMHRPEC"

 D ^XBDBQUE

XIT ;

 D EN^XBVK("AMH")

BROWSE ;

 S XBRP="VIEWR^XBLM(""PRINT^AMHRPEC"")"

 S XBNS="AMH",XBRC="PROC^AMHRPEC",XBRX="XIT^AMHRPEC",XBIOP=0 D ^XBDBQUE

PROC ;EP - entry point for processing

 S AMHJOB=$J,AMHBTH=$H,AMHTOT=0,AMHTDAYS=0,AMHBT=$H,AMHCASE=0

 K AMHSUB

 D XTMP^AMHUTIL("AMHRPEC","BH - DURATION OF CARE REPORT")

 F  S AMHCASE=$O(^AMHPCASE(AMHCASE)) Q:AMHCASE'=+AMHCASE  D PROC1

 S AMHET=$H

 K AMHCASE

PROC1 ;

 I '$$ALLOWCD^AMHLCD(DUZ,AMHCASE) Q  ;not allowed this case

 Q:$P(^AMHPCASE(AMHCASE,0),U,5)=""  ;NO CLOSED DATE

 I AMHPROV,$P(^AMHPCASE(AMHCASE,0),U,8)'=AMHPROV Q  ;not this provider

 I AMHPROG]"",$P(^AMHPCASE(AMHCASE,0),U,3)'=AMHPROG Q  ;not this program

 S AMHOD=$P(^AMHPCASE(AMHCASE,0),U)

 S AMHCD=$P(^AMHPCASE(AMHCASE,0),U,5)

 Q:'$$CD(AMHOD,AMHCD,AMHOPEN,AMHCLOSE)

 S DFN=$P(^AMHPCASE(AMHCASE,0),U,2)

 Q:'DFN

 Q:'$$ALLOWP^AMHUTIL(DUZ,DFN)

 Q:$$DEMO^AMHUTIL1(DFN,$G(AMHDEMO))

 S AMHTOT=AMHTOT+1

 S X=$$FMDIFF^XLFDT(AMHCD,AMHOD)

 S AMHTDAYS=AMHTDAYS+X

 S AMHX=$$VAL^XBDIQ1(9002011.58,AMHCASE,.08) I AMHX="" S AMHX="UNKNOWN PROVIDER"

 S ^XTMP("AMHRPEC",AMHJOB,AMHBTH,"CASES",AMHX,AMHOD,AMHCASE)=$$FMDIFF^XLFDT(AMHCD,AMHOD)

 S AMHSUB(AMHX)=$G(AMHSUB(AMHX))+1,AMHSUBD(AMHX)=$G(AMHSUBD(AMHX))+$$FMDIFF^XLFDT(AMHCD,AMHOD)

CD(O,C,WO,WC) ;

 I WO,O'<AMHBD,O'>AMHED Q 1

 I WC,C'<AMHBD,C'>AMHED Q 1

Q 0

PRINT ;

 S X1=DT,X2=-365 D C^%DTC S AMHBD=X,AMHED=DT

 S Y=AMHBD D DD^%DT S AMHBDD=Y S Y=AMHED D DD^%DT S AMHEDD=Y

 S AMH80D="-------------------------------------------------------------------------------"

 S AMHPG=0

 I '$D(^XTMP("AMHRPEC",AMHJOB,AMHBTH)) W !!,"NO CASES TO REPORT" G DONE

 K AMHQ S AMHCNT=0

 S AMHPROV="" F  S AMHPROV=$O(^XTMP("AMHRPEC",AMHJOB,AMHBTH,"CASES",AMHPROV)) Q:AMHPROV=""!($D(AMHQ))  D

 .S AMHSUB=0,AMHCNT=AMHCNT+1

 .I AMHCNT=1!($G(AMHNPAG)) D HEAD

 .S AMHDATE="" F  S AMHDATE=$O(^XTMP("AMHRPEC",AMHJOB,AMHBTH,"CASES",AMHPROV,AMHDATE)) Q:AMHDATE=""!($D(AMHQ))  D

 ..S AMHCASE=0 F  S AMHCASE=$O(^XTMP("AMHRPEC",AMHJOB,AMHBTH,"CASES",AMHPROV,AMHDATE,AMHCASE)) Q:AMHCASE'=+AMHCASE!($D(AMHQ))  D PRINT1

 .I $Y>(IOSL-5) D HEAD Q:$D(AMHQ)

 .W !!,"Total Number of Cases for "_AMHPROV_": ",AMHSUB(AMHPROV),!

 .W "Average Duration of Care: ",$J((AMHSUBD(AMHPROV)/AMHSUB(AMHPROV)),8,2)," days",!!

 G:$D(AMHQ) DONE

 I $Y>(IOSL-5) D HEAD Q:$D(AMHQ)

 W !!,"Total Number of Cases: ",AMHTOT,!

 W "Average Duration of Care: ",$J((AMHTDAYS/AMHTOT),8,2)," days",!!

DONE ;

 K ^XTMP("AMHRPEC",AMHJOB,AMHBTH),AMHJOB,AMHBTH

PRINT1 ;

 I $Y>(IOSL-3) D HEAD Q:$D(AMHQ)

 S AMHX=^AMHPCASE(AMHCASE,0)

 S DFN=$P(AMHX,U,2)

 W !,$E($P(^DPT(DFN,0),U),1,15),?18,$$HRN^AUPNPAT(DFN,DUZ(2))

 S Y=$P(AMHX,U) W ?25,$E(Y,4,5),"/",$E(Y,6,7),"/",$E(Y,2,3)

 S Y=$P(AMHX,U,5) I Y]"" W ?35,$E(Y,4,5),"/",$E(Y,6,7),"/",$E(Y,2,3)

 W ?47,^XTMP("AMHRPEC",AMHJOB,AMHBTH,"CASES",AMHPROV,AMHDATE,AMHCASE)_" days"

 W ?57,$$VAL^XBDIQ1(9002011.58,AMHCASE,.09)

 W ?65,$E($$VAL^XBDIQ1(9002011.58,AMHCASE,.08),1,14)

HEAD I 'AMHPG G HEAD1

 I $E(IOST)="C",IO=IO(0) W ! S DIR(0)="EO" D ^DIR K DIR I Y=0!(Y="^")!($D(DTOUT)) S AMHQ="" Q

HEAD1 ;

 W:$D(IOF) @IOF S AMHPG=AMHPG+1

 S X="********** CONFIDENTIAL PATIENT INFORMATION **********" W !,$$CTR(X,80)

 W !,$P(^VA(200,DUZ,0),U,2),?72,"Page ",AMHPG,!

 W ?(80-$L($P(^DIC(4,DUZ(2),0),U))/2),$P(^DIC(4,DUZ(2),0),U),!

 S X="Case Dates: "_AMHBDD_" to "_AMHEDD W $$CTR(X,80),!

 S X="DURATION OF CARE REPORT" W $$CTR(X,80)

 I AMHPROG]"" S X="Program: "_$$EXTSET^XBFUNC(9002011.58,.03,AMHPROG) W !,$$CTR(X,80)

PIH W !,"PATIENT NAME",?18,"CHART",?25,"CASE OPEN",?35,"CASE CLOSED",?47,"DURATION",?57,"POV",?65,"PROVIDER"

 W !?18,"NUMBER",?25,"DATE",?35,"DATE"

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

C(X,X2,X3) ;

 D COMMA^%DTC

 Q $$STRIP^XLFSTR(X," ")

D(D) ;EP

 I $G(D)="" Q ""

 Q $E(D,4,5)_"/"_$E(D,6,7)_"/"_$E(D,2,3)

CTR(X,Y) ;EP - Center X in a field Y wide.

 Q $J("",$S($D(Y):Y,1:IOM)-$L(X)\2)_X

 ;----------

AMHRPEC   ; IHS/CMI/LAB - ACTIVE CLIENT LIST ;

 +1       ;;4.0;IHS BEHAVIORAL HEALTH;;MAY 14, 2010

 +2       ;

START     ;

 +1        IF '$DATA(IOF)

               DO HOME^%ZIS

 +2        WRITE @(IOF),!!

 +3        WRITE "**********  DURATION OF CARE REPORT  **********",!!

 +4        WRITE "This report will produce a list of all closed cases in a date"

 +5        WRITE !,"range that you specify.  In order to be included in this report"

 +6        WRITE !,"the case must have both a case open and a case closed date."

 +7        WRITE !,"The duration of care is calculated by counting the number of days"

 +8        WRITE !,"from the case open date to the case closed date."

 +9        WRITE !!,"Cases may be selected based on Open date, Closed date or both."

 +10       WRITE !,"Only those cases falling within the specified time frame will be"

 +11       WRITE !,"counted."

 +12       WRITE !!

 +13       IF '$DATA(^AMHSITE(DUZ(2),16,DUZ))

               Begin DoDot:1

 +14               WRITE !,"This report will only include Cases on which you are the documented"

 +15               WRITE !,"provider.",!!

               End DoDot:1

 +16       DO DBHUSRP^AMHUTIL

 +17       DO XIT

DATES      KILL AMHED,AMHBD

 +1        KILL DIR

           WRITE !

           SET DIR(0)="DO^::EXP"

           SET DIR("A")="Enter Beginning Date"

 +2        DO ^DIR

           IF Y<1

               GOTO XIT

           SET AMHBD=Y

 +3        KILL DIR

           SET DIR(0)="DO^:DT:EXP"

           SET DIR("A")="Enter Ending Date"

 +4        DO ^DIR

           IF Y<1

               GOTO XIT

           SET AMHED=Y

 +5       ;

 +6        IF AMHED<AMHBD

               Begin DoDot:1

 +7                WRITE !!,$CHAR(7),"Sorry, Ending Date MUST not be earlier than Beginning Date."

               End DoDot:1

               GOTO DATES

 +8        SET AMHSD=$$FMADD^XLFDT(AMHBD,-1)_".9999"

WHICH     ;

 +1        SET (AMHOPEN,AMHCLOSE)=""

 +2        SET DIR(0)="S^O:Cases OPENED in that Date Range;C:Cases CLOSED in that Date Range;B:Cases either opened or closed in that Date Range"

 +3        SET DIR("A")="Please Select which Dates should be Used"

           SET DIR("B")="B"

           KILL DA

           DO ^DIR

           KILL DIR

 +4        IF $DATA(DIRUT)

               GOTO DATES

 +5        IF Y="O"

               SET AMHOPEN=1

 +6        IF Y="C"

               SET AMHCLOSE=1

 +7        IF Y="B"

               SET (AMHOPEN,AMHCLOSE)=1

PROG      ;

 +1        SET AMHPROG=""

 +2        SET DIR(0)="S^O:ONE Program;A:ALL Programs"

           SET DIR("A")="Run the Report for which PROGRAM"

           SET DIR("B")="A"

           KILL DA

           DO ^DIR

           KILL DIR

 +3        IF $DATA(DIRUT)

               GOTO WHICH

 +4        IF Y="A"

               GOTO PROV

 +5        SET DIR(0)="9002011.58,.03"

           SET DIR("A")="Which PROGRAM"

           KILL DA

           DO ^DIR

           KILL DIR

 +6        IF $DATA(DIRUT)

               GOTO PROG

 +7        IF X=""

               GOTO PROG

 +8        SET AMHPROG=Y

PROV      ;

 +1        WRITE !

 +2        SET AMHPROV=""

 +3        SET DIR(0)="S^A:All Providers;O:One Provider"

           SET DIR("A")="Include cases opened by"

           SET DIR("B")="A"

           KILL DA

           DO ^DIR

           KILL DIR

 +4        IF $DATA(DIRUT)

               GOTO XIT

 +5        IF Y="A"

               GOTO PAGE

 +6        SET DIC="^VA(200,"

           SET DIC(0)="AEMQ"

           SET DIC("A")="Which PROVIDER: "

           DO ^DIC

 +7        KILL DIC,DA

 +8        IF Y=-1

               GOTO PROV

 +9        SET AMHPROV=+Y

 +10       GOTO ZIS

PAGE      ;

 +1        SET AMHNPAG=0

           SET DIR(0)="Y"

           SET DIR("A")="Do you want each Provider on a separate page"

           SET DIR("B")="N"

           KILL DA

           DO ^DIR

           KILL DIR

 +2        IF $DATA(DIRUT)

               GOTO PROV

 +3        SET AMHNPAG=Y

ZIS       ;

DEMO      ;

 +1        DO DEMOCHK^AMHUTIL1(.AMHDEMO)

 +2        IF AMHDEMO=-1

               GOTO PROV

 +3        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

 +4        IF $DATA(DIRUT)

               GOTO XIT

 +5        IF $GET(Y)="B"

               DO BROWSE

               DO XIT

               QUIT

 +6        SET XBRC="PROC^AMHRPEC"

           SET XBRP="PRINT^AMHRPEC"

           SET XBNS="AMH"

           SET XBRX="XIT^AMHRPEC"

 +7        DO ^XBDBQUE

XIT       ;

 +1        DO EN^XBVK("AMH")

 +2        QUIT

 +3       ;

BROWSE    ;

 +1        SET XBRP="VIEWR^XBLM(""PRINT^AMHRPEC"")"

 +2        SET XBNS="AMH"

           SET XBRC="PROC^AMHRPEC"

           SET XBRX="XIT^AMHRPEC"

           SET XBIOP=0

           DO ^XBDBQUE

 +3        QUIT

PROC      ;EP - entry point for processing

 +1        SET AMHJOB=$JOB

           SET AMHBTH=$HOROLOG

           SET AMHTOT=0

           SET AMHTDAYS=0

           SET AMHBT=$HOROLOG

           SET AMHCASE=0

 +2        KILL AMHSUB

 +3        DO XTMP^AMHUTIL("AMHRPEC","BH - DURATION OF CARE REPORT")

 +4        FOR

               SET AMHCASE=$ORDER(^AMHPCASE(AMHCASE))

               IF AMHCASE'=+AMHCASE

                   QUIT

               DO PROC1

 +5        SET AMHET=$HOROLOG

 +6        KILL AMHCASE

 +7        QUIT

PROC1     ;

 +1       ;not allowed this case

           IF '$$ALLOWCD^AMHLCD(DUZ,AMHCASE)

               QUIT

 +2       ;NO CLOSED DATE

           IF $PIECE(^AMHPCASE(AMHCASE,0),U,5)=""

               QUIT

 +3       ;not this provider

           IF AMHPROV

               IF $PIECE(^AMHPCASE(AMHCASE,0),U,8)'=AMHPROV

                   QUIT

 +4       ;not this program

           IF AMHPROG]""

               IF $PIECE(^AMHPCASE(AMHCASE,0),U,3)'=AMHPROG

                   QUIT

 +5        SET AMHOD=$PIECE(^AMHPCASE(AMHCASE,0),U)

 +6        SET AMHCD=$PIECE(^AMHPCASE(AMHCASE,0),U,5)

 +7        IF '$$CD(AMHOD,AMHCD,AMHOPEN,AMHCLOSE)

               QUIT

 +8        SET DFN=$PIECE(^AMHPCASE(AMHCASE,0),U,2)

 +9        IF 'DFN

               QUIT

 +10       IF '$$ALLOWP^AMHUTIL(DUZ,DFN)

               QUIT

 +11       IF $$DEMO^AMHUTIL1(DFN,$GET(AMHDEMO))

               QUIT

 +12       SET AMHTOT=AMHTOT+1

 +13       SET X=$$FMDIFF^XLFDT(AMHCD,AMHOD)

 +14       SET AMHTDAYS=AMHTDAYS+X

 +15       SET AMHX=$$VAL^XBDIQ1(9002011.58,AMHCASE,.08)

           IF AMHX=""

               SET AMHX="UNKNOWN PROVIDER"

 +16       SET ^XTMP("AMHRPEC",AMHJOB,AMHBTH,"CASES",AMHX,AMHOD,AMHCASE)=$$FMDIFF^XLFDT(AMHCD,AMHOD)

 +17       SET AMHSUB(AMHX)=$GET(AMHSUB(AMHX))+1

           SET AMHSUBD(AMHX)=$GET(AMHSUBD(AMHX))+$$FMDIFF^XLFDT(AMHCD,AMHOD)

 +18       QUIT

 +19      ;

CD(O,C,WO,WC) ;

 +1        IF WO

               IF O'<AMHBD

                   IF O'>AMHED

                       QUIT 1

 +2        IF WC

               IF C'<AMHBD

                   IF C'>AMHED

                       QUIT 1

 +3        QUIT 0

PRINT     ;

 +1        SET X1=DT

           SET X2=-365

           DO C^%DTC

           SET AMHBD=X

           SET AMHED=DT

 +2        SET Y=AMHBD

           DO DD^%DT

           SET AMHBDD=Y

           SET Y=AMHED

           DO DD^%DT

           SET AMHEDD=Y

 +3        SET AMH80D="-------------------------------------------------------------------------------"

 +4        SET AMHPG=0

 +5        IF '$DATA(^XTMP("AMHRPEC",AMHJOB,AMHBTH))

               WRITE !!,"NO CASES TO REPORT"

               GOTO DONE

 +6        KILL AMHQ

           SET AMHCNT=0

 +7        SET AMHPROV=""

FOR

               SET AMHPROV=$ORDER(^XTMP("AMHRPEC",AMHJOB,AMHBTH,"CASES",AMHPROV))

               IF AMHPROV=""!($DATA(AMHQ))

                   QUIT

               Begin DoDot:1

 +8                SET AMHSUB=0

                   SET AMHCNT=AMHCNT+1

 +9                IF AMHCNT=1!($GET(AMHNPAG))

                       DO HEAD

 +10               SET AMHDATE=""

FOR

                       SET AMHDATE=$ORDER(^XTMP("AMHRPEC",AMHJOB,AMHBTH,"CASES",AMHPROV,AMHDATE))

                       IF AMHDATE=""!($DATA(AMHQ))

                           QUIT

                       Begin DoDot:2

 +11                       SET AMHCASE=0

FOR

                               SET AMHCASE=$ORDER(^XTMP("AMHRPEC",AMHJOB,AMHBTH,"CASES",AMHPROV,AMHDATE,AMHCASE))

                               IF AMHCASE'=+AMHCASE!($DATA(AMHQ))

                                   QUIT

                               DO PRINT1

                       End DoDot:2

 +12               IF $Y>(IOSL-5)

                       DO HEAD

                       IF $DATA(AMHQ)

                           QUIT

 +13               WRITE !!,"Total Number of Cases for "_AMHPROV_": ",AMHSUB(AMHPROV),!

 +14               WRITE "Average Duration of Care: ",$JUSTIFY((AMHSUBD(AMHPROV)/AMHSUB(AMHPROV)),8,2)," days",!!

               End DoDot:1

 +15       IF $DATA(AMHQ)

               GOTO DONE

 +16       IF $Y>(IOSL-5)

               DO HEAD

               IF $DATA(AMHQ)

                   QUIT

 +17       WRITE !!,"Total Number of Cases: ",AMHTOT,!

 +18       WRITE "Average Duration of Care: ",$JUSTIFY((AMHTDAYS/AMHTOT),8,2)," days",!!

DONE      ;

 +1        KILL ^XTMP("AMHRPEC",AMHJOB,AMHBTH),AMHJOB,AMHBTH

 +2        QUIT

PRINT1    ;

 +1        IF $Y>(IOSL-3)

               DO HEAD

               IF $DATA(AMHQ)

                   QUIT

 +2        SET AMHX=^AMHPCASE(AMHCASE,0)

 +3        SET DFN=$PIECE(AMHX,U,2)

 +4        WRITE !,$EXTRACT($PIECE(^DPT(DFN,0),U),1,15),?18,$$HRN^AUPNPAT(DFN,DUZ(2))

 +5        SET Y=$PIECE(AMHX,U)

           WRITE ?25,$EXTRACT(Y,4,5),"/",$EXTRACT(Y,6,7),"/",$EXTRACT(Y,2,3)

 +6        SET Y=$PIECE(AMHX,U,5)

           IF Y]""

               WRITE ?35,$EXTRACT(Y,4,5),"/",$EXTRACT(Y,6,7),"/",$EXTRACT(Y,2,3)

 +7        WRITE ?47,^XTMP("AMHRPEC",AMHJOB,AMHBTH,"CASES",AMHPROV,AMHDATE,AMHCASE)_" days"

 +8        WRITE ?57,$$VAL^XBDIQ1(9002011.58,AMHCASE,.09)

 +9        WRITE ?65,$EXTRACT($$VAL^XBDIQ1(9002011.58,AMHCASE,.08),1,14)

 +10       QUIT

HEAD       IF 'AMHPG

               GOTO HEAD1

 +1        IF $EXTRACT(IOST)="C"

               IF IO=IO(0)

                   WRITE !

                   SET DIR(0)="EO"

                   DO ^DIR

                   KILL DIR

                   IF Y=0!(Y="^")!($DATA(DTOUT))

                       SET AMHQ=""

                       QUIT

HEAD1     ;

 +1        IF $DATA(IOF)

               WRITE @IOF

           SET AMHPG=AMHPG+1

 +2        SET X="********** CONFIDENTIAL PATIENT INFORMATION **********"

           WRITE !,$$CTR(X,80)

 +3        WRITE !,$PIECE(^VA(200,DUZ,0),U,2),?72,"Page ",AMHPG,!

 +4        WRITE ?(80-$LENGTH($PIECE(^DIC(4,DUZ(2),0),U))/2),$PIECE(^DIC(4,DUZ(2),0),U),!

 +5        SET X="Case Dates: "_AMHBDD_" to "_AMHEDD

           WRITE $$CTR(X,80),!

 +6        SET X="DURATION OF CARE REPORT"

           WRITE $$CTR(X,80)

 +7        IF AMHPROG]""

               SET X="Program: "_$$EXTSET^XBFUNC(9002011.58,.03,AMHPROG)

               WRITE !,$$CTR(X,80)

PIH        WRITE !,"PATIENT NAME",?18,"CHART",?25,"CASE OPEN",?35,"CASE CLOSED",?47,"DURATION",?57,"POV",?65,"PROVIDER"

 +1        WRITE !?18,"NUMBER",?25,"DATE",?35,"DATE"

 +2        WRITE !,$$REPEAT^XLFSTR("-",80),!

 +3        QUIT

C(X,X2,X3) ;

 +1        DO COMMA^%DTC

 +2        QUIT $$STRIP^XLFSTR(X," ")

D(D)      ;EP

 +1        IF $GET(D)=""

               QUIT ""

 +2        QUIT $EXTRACT(D,4,5)_"/"_$EXTRACT(D,6,7)_"/"_$EXTRACT(D,2,3)

CTR(X,Y)  ;EP - Center X in a field Y wide.

 +1        QUIT $JUSTIFY("",$SELECT($DATA(Y):Y,1:IOM)-$LENGTH(X)\2)_X

 +2       ;----------

AMHRPEC.m