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
Q
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
Q
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))
Q
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
Q
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)
