Routine: AMHRC1P

AMHRC1P ; IHS/CMI/LAB - print active client list (using case open/close) ;

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

PRINT ;

START ;

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

 S AMHPG=0 D HEAD

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

 S DFN="" K AMHQ

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

 .S DFN=0 F  S DFN=$O(^XTMP("AMHRC1",AMHJOB,AMHBTH,"CASES",AMHNAME,DFN)) Q:DFN'=+DFN!($D(AMHQ))  D DFN

 G:$D(AMHQ) DONE

 W !!,"Total Number of Patients: ",AMHPCNT,!

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

DONE D DONE^AMHLEIN,^AMHEKL

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

DFN ;

 S AMHCASE=0 F  S AMHCASE=$O(^XTMP("AMHRC1",AMHJOB,AMHBTH,"CASES",AMHNAME,DFN,AMHCASE)) Q:AMHCASE'=+AMHCASE!($D(AMHQ))  S AMHR=^AMHPCASE(AMHCASE,0) D PRN

PRN ;

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

 S AMHHRCN=$S($D(^AUPNPAT(DFN,41,DUZ(2),0)):$P(^(0),U,2),1:"<none>")

 W !,$E($P(^DPT(DFN,0),U),1,15),?18,AMHHRCN

 W ?26,$P(^DPT(DFN,0),U,2) S Y=$P(^DPT(DFN,0),U,3) W ?28,$E(Y,4,5),"/",$E(Y,6,7),"/",$E(Y,2,3)

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

 W ?48,$E($$VAL^XBDIQ1(9002011.58,AMHCASE,.08),1,12)

 S D=$P(^XTMP("AMHRC1",AMHJOB,AMHBTH,"CASES",AMHNAME,DFN,AMHCASE),U)

 W ?62,$$D(D)

 W ?72,$S(D="":"not seen",1:$$FMDIFF^XLFDT(DT,D))

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

 W !?13,"********** CONFIDENTIAL PATIENT INFORMATION **********"

 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),!

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

 W ?10,"ACTIVE CLIENT LIST (CASE OPEN & NOT SEEN IN ",AMHDAYS," DAYS)"

PIH W !,"PATIENT NAME",?18,"CHART",?25,"SEX",?31,"DOB",?38,"CASE OPEN",?48,"PROVIDER",?62,"DATE LAST",?72,"# DAYS"

 W !?18,"NUMBER",?38,"DATE",?62,"SEEN",?72,"SINCE",!,AMH80D

D(D) ;

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

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

AMHRC1P   ; IHS/CMI/LAB - print active client list (using case open/close) ;

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

 +2       ;

 +3       ;

PRINT     ;

START     ;

 +1        SET AMH80D="-------------------------------------------------------------------------------"

 +2        SET AMHPG=0

           DO HEAD

 +3        IF '$DATA(^XTMP("AMHRC1",AMHJOB,AMHBTH))

               WRITE !!,"NO PATIENTS TO REPORT"

               GOTO DONE

 +4        SET DFN=""

           KILL AMHQ

 +5        SET AMHNAME=""

FOR

               SET AMHNAME=$ORDER(^XTMP("AMHRC1",AMHJOB,AMHBTH,"CASES",AMHNAME))

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

                   QUIT

               Begin DoDot:1

 +6                SET DFN=0

FOR

                       SET DFN=$ORDER(^XTMP("AMHRC1",AMHJOB,AMHBTH,"CASES",AMHNAME,DFN))

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

                           QUIT

                       DO DFN

               End DoDot:1

 +7        IF $DATA(AMHQ)

               GOTO DONE

 +8        WRITE !!,"Total Number of Patients: ",AMHPCNT,!

 +9        WRITE "Total Number of Cases: ",AMHCCNT,!

DONE       DO DONE^AMHLEIN

           DO ^AMHEKL

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

 +2        QUIT

DFN       ;

 +1        SET AMHCASE=0

FOR

               SET AMHCASE=$ORDER(^XTMP("AMHRC1",AMHJOB,AMHBTH,"CASES",AMHNAME,DFN,AMHCASE))

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

                   QUIT

               SET AMHR=^AMHPCASE(AMHCASE,0)

               DO PRN

 +2        QUIT

PRN       ;

 +1        IF $Y>(IOSL-4)

               DO HEAD

               IF $DATA(AMHQ)

                   QUIT

 +2        SET AMHHRCN=$SELECT($DATA(^AUPNPAT(DFN,41,DUZ(2),0)):$PIECE(^(0),U,2),1:"<none>")

 +3        WRITE !,$EXTRACT($PIECE(^DPT(DFN,0),U),1,15),?18,AMHHRCN

 +4        WRITE ?26,$PIECE(^DPT(DFN,0),U,2)

           SET Y=$PIECE(^DPT(DFN,0),U,3)

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

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

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

 +6        WRITE ?48,$EXTRACT($$VAL^XBDIQ1(9002011.58,AMHCASE,.08),1,12)

 +7        SET D=$PIECE(^XTMP("AMHRC1",AMHJOB,AMHBTH,"CASES",AMHNAME,DFN,AMHCASE),U)

 +8        WRITE ?62,$$D(D)

 +9        WRITE ?72,$SELECT(D="":"not seen",1:$$FMDIFF^XLFDT(DT,D))

 +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        WRITE !?13,"********** CONFIDENTIAL PATIENT INFORMATION **********"

 +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        IF AMHPROG]""

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

               WRITE $$CTR^AMHRP4P(X,80),!

 +6        WRITE ?10,"ACTIVE CLIENT LIST (CASE OPEN & NOT SEEN IN ",AMHDAYS," DAYS)"

PIH        WRITE !,"PATIENT NAME",?18,"CHART",?25,"SEX",?31,"DOB",?38,"CASE OPEN",?48,"PROVIDER",?62,"DATE LAST",?72,"# DAYS"

 +1        WRITE !?18,"NUMBER",?38,"DATE",?62,"SEEN",?72,"SINCE",!,AMH80D

 +2        QUIT

D(D)      ;

 +1        IF $GET(D)=""

               QUIT ""

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

AMHRC1P.m