AMHRC4 ; IHS/CMI/LAB - ACTIVE CLIENT LIST - OPEN NOT SEEN IN N DAYS 03 Jun 2009 12:08 PM ;
;;4.0;IHS BEHAVIORAL HEALTH;**4**;JUN 18, 2010;Build 28
;
START ;
I '$D(IOF) D HOME^%ZIS
W @(IOF),!!
W "******* CLIENTS SEEN AT LEAST X TIMES WITH NO CASE OPEN DATE *******",!!
W "This report will produce a list of patients, in a date range specified"
W !,"by the user, who have been seen a certain number of times but do not"
W !,"have open cases. The user, based on their program's standards"
W !,"of care, specifies when a case is to be opened. For example,"
W !,"a case will be opened if a patient has been seen at least (3) times."
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,DBHUSR^AMHUTIL,PAUSE^AMHLEA
DATES K AMHED,AMHBD
K DIR W ! S DIR(0)="DO^::EXP",DIR("A")="Enter Beginning Visit Date"
D ^DIR G:Y<1 XIT S AMHBD=Y
K DIR S DIR(0)="DO^:DT:EXP",DIR("A")="Enter Ending Visit 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"
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) DATES
;I Y="A" G DAYS
S DIR(0)="9002011,.02",DIR("A")="Run Report for which PROGRAM" KILL DA D ^DIR KILL DIR
G:$D(DIRUT) DATES
I X="" G DATES
S AMHPROG=Y
PROV ;
S AMHPROV=""
S DIR(0)="S^A:All Providers;O:One Provider",DIR("A")="Include visits to",DIR("B")="A" K DA D ^DIR K DIR
G:$D(DIRUT) XIT
I Y="A" G DAYS
S DIC="^VA(200,",DIC(0)="AEMQ",DIC("A")="Which PROVIDER: " D ^DIC
K DIC,DA
I Y=-1 G PROV
S AMHPROV=+Y
DAYS ;
S AMHDAYS=0
S DIR(0)="NA^1:999:0",DIR("A")="Enter the number of visits (X number of visits with no case opened): " K DA D ^DIR K DIR
I $D(DIRUT) W !,"Bye..." D XIT Q
I Y="" D XIT Q
S AMHDAYS=Y
DEMO ;
D DEMOCHK^AMHUTIL1(.AMHDEMO)
I AMHDEMO=-1 G DAYS
ZIS ;
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^AMHRC4",XBRP="PRINT^AMHRC4",XBNS="AMH",XBRX="XIT^AMHRC4"
D ^XBDBQUE
XIT ;
D EN^XBVK("AMH")
D KILL^AUPNPAT
Q
;
BROWSE ;
S XBRP="VIEWR^XBLM(""PRINT^AMHRC4"")"
S XBNS="AMH",XBRC="PROC^AMHRC4",XBRX="XIT^AMHRC4",XBIOP=0 D ^XBDBQUE
Q
PROC ;EP - entry point for processing
S AMHPCNT=0,AMHCCNT=0
S AMHJOB=$J,AMHBTH=$H,AMHBT=$H
D XTMP^AMHUTIL("AMHRC4","BH - REPORT - SEEN NOT OPEN")
S AMHODAT=AMHSD F S AMHODAT=$O(^AMHREC("B",AMHODAT)) Q:AMHODAT=""!((AMHODAT\1)>AMHED) D PROC1
S AMHET=$H
K AMHCASE
Q
PROC1 ;
S AMHVIEN=0 F S AMHVIEN=$O(^AMHREC("B",AMHODAT,AMHVIEN)) Q:AMHVIEN'=+AMHVIEN D PROC2
Q
PROC2 ;
Q:'$D(^AMHREC(AMHVIEN,0))
Q:'$$ALLOWVI^AMHUTIL(DUZ,AMHVIEN)
;I AMHPROG]"",$P(^AMHREC(AMHVIEN,0),U,2)'=AMHPROG Q ;not correct program visit
S DFN=$P(^AMHREC(AMHVIEN,0),U,8)
Q:'DFN ;not patient record
Q:'$$ALLOWP^AMHUTIL(DUZ,DFN)
Q:$$DEMO^AMHUTIL1(DFN,$G(AMHDEMO))
I $D(^XTMP("AMHRC4",AMHJOB,AMHBTH,"PATIENTS PROCESSED",DFN)) Q ;already processed this patient
S X=$$VS(DFN,AMHBD,AMHED,AMHPROG,AMHPROV) ;x=# of visits in date range
Q:$P(X,U)<AMHDAYS ;not enough visits
;now check for case open date
S AMHLASTD=$P(X,U,2)
S AMHLASTV=$P(X,U,3)
S AMHCV=$P(X,U,1)
S X=0,G=0 F S X=$O(^AMHPCASE("C",DFN,X)) Q:X'=+X D
.Q:'$$ALLOWCD^AMHLCD(DUZ,X)
.I $P(^AMHPCASE(X,0),U,5)]"",$P(^AMHPCASE(X,0),U,5)<AMHLASTD Q ;closed before last visit date
.S G=1 ;has case open
.Q
Q:G
S ^XTMP("AMHRC4",AMHJOB,AMHBTH,"HITS",$P(^DPT(DFN,0),U),DFN)=AMHCV_U_AMHLASTV_U_AMHLASTD,AMHPCNT=AMHPCNT+1
S ^XTMP("AMHRC4",AMHJOB,AMHBTH,"PATIENTS PROCESSED",DFN)=""
Q
VS(P,BD,ED,R,W) ;
I '$D(^AMHREC("C",P)) Q 0
NEW S,X,Y,Z,C,A,B
S C=0,Y="",Z=""
S S=$$FMADD^XLFDT(BD,-1)_".9999"
F S S=$O(^AMHREC("AF",P,S)) Q:S=""!($P(S,".")>ED) D
.S X=0 F S X=$O(^AMHREC("AF",P,S,X)) Q:X'=+X D
..I $$NS(X) Q ;don't count no shows
..I R]"",$P(^AMHREC(X,0),U,2)'=R Q
..Q:'$$ALLOWVI^AMHUTIL(DUZ,X)
..I W]"" D Q:'G
...S G=0
...S A=0 F S A=$O(^AMHRPROV("AD",X,A)) Q:A'=+A!(G) I $P($G(^AMHRPROV(A,0)),U)=W S G=1
..S C=C+1,Y=S,Z=X ;Y is last date
..Q
.Q
Q C_U_Y_U_Z
NS(V) ;
NEW H,I,J,K,DNKA
S DNKA=0
S H=0 F S H=$O(^AMHRPRO("AD",V,H)) Q:H'=+H!(DNKA) D
.I $P(^AMHPROB($P(^AMHRPRO(H,0),U),0),U)=8 S DNKA=1 Q
.I $P(^AMHPROB($P(^AMHRPRO(H,0),U),0),U)=8.1 S DNKA=1 Q
.I $P(^AMHPROB($P(^AMHRPRO(H,0),U),0),U)=8.11 S DNKA=1 Q
.I $P(^AMHPROB($P(^AMHRPRO(H,0),U),0),U)=8.2 S DNKA=1 Q
.I $P(^AMHPROB($P(^AMHRPRO(H,0),U),0),U)=8.21 S DNKA=1 Q
.I $P(^AMHPROB($P(^AMHRPRO(H,0),U),0),U)=8.3 S DNKA=1 Q
.Q
Q DNKA
PRINT ;
S AMH80D="-------------------------------------------------------------------------------"
S AMHPG=0 D HEAD
I '$D(^XTMP("AMHRC4",AMHJOB,AMHBTH,"HITS")) W !!,"NO PATIENTS TO REPORT" G DONE
S DFN="" K AMHQ
S AMHNAME="" F S AMHNAME=$O(^XTMP("AMHRC4",AMHJOB,AMHBTH,"HITS",AMHNAME)) Q:AMHNAME=""!($D(AMHQ)) D
.S DFN=0 F S DFN=$O(^XTMP("AMHRC4",AMHJOB,AMHBTH,"HITS",AMHNAME,DFN)) Q:DFN'=+DFN!($D(AMHQ)) D PRN
G:$D(AMHQ) DONE
W !!,"Total Number of Patients: ",AMHPCNT,!
DONE ;
K ^XTMP("AMHRC4",AMHJOB,AMHBTH),AMHJOB,AMHBTH
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)
W ?38,$P(^XTMP("AMHRC4",AMHJOB,AMHBTH,"HITS",AMHNAME,DFN),U,1)
W ?45,$$D($P(^XTMP("AMHRC4",AMHJOB,AMHBTH,"HITS",AMHNAME,DFN),U,3))
S V=$P(^XTMP("AMHRC4",AMHJOB,AMHBTH,"HITS",AMHNAME,DFN),U,2)
W ?56,$$LASTDX(V)
W ?65,$E($$PPNAME^AMHUTIL(V),1,14)
Q
LASTDX(V) ;
;get last pov
NEW X
S X=$O(^AMHRPRO("AD",V,0))
I X="" Q ""
Q $$VAL^XBDIQ1(9002011.01,X,.01)
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),!
S X="PATIENTS SEEN AT LEAST "_AMHDAYS_" TIMES WITH NO CASE OPEN DATE" W $$CJ^XLFSTR(X,80),!
S X="VISIT DATE RANGE: "_$$FMTE^XLFDT(AMHBD)_" to "_$$FMTE^XLFDT(AMHED) W $$CJ^XLFSTR(X,80),!
I AMHPROG]"" S X="VISITS TO PROGRAM: "_$$EXTSET^XBFUNC(9002011,.02,AMHPROG) W !,$$CTR(X,80)
W !,"PATIENT NAME",?18,"CHART",?25,"SEX",?31,"DOB",?38,"#",?45,"LAST VISIT",?56,"LAST",?63,"PROVIDER"
W !?18,"NUMBER",?38,"VISITS",?56,"DX"
W !,$$REPEAT^XLFSTR("-",80),!
Q
D(D) ;
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
;----------
AMHRC4 ; IHS/CMI/LAB - ACTIVE CLIENT LIST - OPEN NOT SEEN IN N DAYS 03 Jun 2009 12:08 PM ;
+1 ;;4.0;IHS BEHAVIORAL HEALTH;**4**;JUN 18, 2010;Build 28
+2 ;
START ;
+1 IF '$DATA(IOF)
DO HOME^%ZIS
+2 WRITE @(IOF),!!
+3 WRITE "******* CLIENTS SEEN AT LEAST X TIMES WITH NO CASE OPEN DATE *******",!!
+4 WRITE "This report will produce a list of patients, in a date range specified"
+5 WRITE !,"by the user, who have been seen a certain number of times but do not"
+6 WRITE !,"have open cases. The user, based on their program's standards"
+7 WRITE !,"of care, specifies when a case is to be opened. For example,"
+8 WRITE !,"a case will be opened if a patient has been seen at least (3) times."
+9 WRITE !
+10 ;
+11 IF '$DATA(^AMHSITE(DUZ(2),16,DUZ))
Begin DoDot:1
+12 WRITE !,"This report will only include Cases on which you are the documented"
+13 WRITE !,"provider.",!!
End DoDot:1
+14 DO DBHUSRP^AMHUTIL
DO DBHUSR^AMHUTIL
DO PAUSE^AMHLEA
DATES KILL AMHED,AMHBD
+1 KILL DIR
WRITE !
SET DIR(0)="DO^::EXP"
SET DIR("A")="Enter Beginning Visit 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 Visit 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"
PROG ;
+1 SET AMHPROG=""
+2 ;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
+3 ;G:$D(DIRUT) DATES
+4 ;I Y="A" G DAYS
+5 SET DIR(0)="9002011,.02"
SET DIR("A")="Run Report for which PROGRAM"
KILL DA
DO ^DIR
KILL DIR
+6 IF $DATA(DIRUT)
GOTO DATES
+7 IF X=""
GOTO DATES
+8 SET AMHPROG=Y
PROV ;
+1 SET AMHPROV=""
+2 SET DIR(0)="S^A:All Providers;O:One Provider"
SET DIR("A")="Include visits to"
SET DIR("B")="A"
KILL DA
DO ^DIR
KILL DIR
+3 IF $DATA(DIRUT)
GOTO XIT
+4 IF Y="A"
GOTO DAYS
+5 SET DIC="^VA(200,"
SET DIC(0)="AEMQ"
SET DIC("A")="Which PROVIDER: "
DO ^DIC
+6 KILL DIC,DA
+7 IF Y=-1
GOTO PROV
+8 SET AMHPROV=+Y
DAYS ;
+1 SET AMHDAYS=0
+2 SET DIR(0)="NA^1:999:0"
SET DIR("A")="Enter the number of visits (X number of visits with no case opened): "
KILL DA
DO ^DIR
KILL DIR
+3 IF $DATA(DIRUT)
WRITE !,"Bye..."
DO XIT
QUIT
+4 IF Y=""
DO XIT
QUIT
+5 SET AMHDAYS=Y
DEMO ;
+1 DO DEMOCHK^AMHUTIL1(.AMHDEMO)
+2 IF AMHDEMO=-1
GOTO DAYS
ZIS ;
+1 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
+2 IF $DATA(DIRUT)
GOTO XIT
+3 IF $GET(Y)="B"
DO BROWSE
DO XIT
QUIT
+4 SET XBRC="PROC^AMHRC4"
SET XBRP="PRINT^AMHRC4"
SET XBNS="AMH"
SET XBRX="XIT^AMHRC4"
+5 DO ^XBDBQUE
XIT ;
+1 DO EN^XBVK("AMH")
+2 DO KILL^AUPNPAT
+3 QUIT
+4 ;
BROWSE ;
+1 SET XBRP="VIEWR^XBLM(""PRINT^AMHRC4"")"
+2 SET XBNS="AMH"
SET XBRC="PROC^AMHRC4"
SET XBRX="XIT^AMHRC4"
SET XBIOP=0
DO ^XBDBQUE
+3 QUIT
PROC ;EP - entry point for processing
+1 SET AMHPCNT=0
SET AMHCCNT=0
+2 SET AMHJOB=$JOB
SET AMHBTH=$HOROLOG
SET AMHBT=$HOROLOG
+3 DO XTMP^AMHUTIL("AMHRC4","BH - REPORT - SEEN NOT OPEN")
+4 SET AMHODAT=AMHSD
FOR
SET AMHODAT=$ORDER(^AMHREC("B",AMHODAT))
IF AMHODAT=""!((AMHODAT\1)>AMHED)
QUIT
DO PROC1
+5 SET AMHET=$HOROLOG
+6 KILL AMHCASE
+7 QUIT
PROC1 ;
+1 SET AMHVIEN=0
FOR
SET AMHVIEN=$ORDER(^AMHREC("B",AMHODAT,AMHVIEN))
IF AMHVIEN'=+AMHVIEN
QUIT
DO PROC2
+2 QUIT
PROC2 ;
+1 IF '$DATA(^AMHREC(AMHVIEN,0))
QUIT
+2 IF '$$ALLOWVI^AMHUTIL(DUZ,AMHVIEN)
QUIT
+3 ;I AMHPROG]"",$P(^AMHREC(AMHVIEN,0),U,2)'=AMHPROG Q ;not correct program visit
+4 SET DFN=$PIECE(^AMHREC(AMHVIEN,0),U,8)
+5 ;not patient record
IF 'DFN
QUIT
+6 IF '$$ALLOWP^AMHUTIL(DUZ,DFN)
QUIT
+7 IF $$DEMO^AMHUTIL1(DFN,$GET(AMHDEMO))
QUIT
+8 ;already processed this patient
IF $DATA(^XTMP("AMHRC4",AMHJOB,AMHBTH,"PATIENTS PROCESSED",DFN))
QUIT
+9 ;x=# of visits in date range
SET X=$$VS(DFN,AMHBD,AMHED,AMHPROG,AMHPROV)
+10 ;not enough visits
IF $PIECE(X,U)<AMHDAYS
QUIT
+11 ;now check for case open date
+12 SET AMHLASTD=$PIECE(X,U,2)
+13 SET AMHLASTV=$PIECE(X,U,3)
+14 SET AMHCV=$PIECE(X,U,1)
+15 SET X=0
SET G=0
FOR
SET X=$ORDER(^AMHPCASE("C",DFN,X))
IF X'=+X
QUIT
Begin DoDot:1
+16 IF '$$ALLOWCD^AMHLCD(DUZ,X)
QUIT
+17 ;closed before last visit date
IF $PIECE(^AMHPCASE(X,0),U,5)]""
IF $PIECE(^AMHPCASE(X,0),U,5)<AMHLASTD
QUIT
+18 ;has case open
SET G=1
+19 QUIT
End DoDot:1
+20 IF G
QUIT
+21 SET ^XTMP("AMHRC4",AMHJOB,AMHBTH,"HITS",$PIECE(^DPT(DFN,0),U),DFN)=AMHCV_U_AMHLASTV_U_AMHLASTD
SET AMHPCNT=AMHPCNT+1
+22 SET ^XTMP("AMHRC4",AMHJOB,AMHBTH,"PATIENTS PROCESSED",DFN)=""
+23 QUIT
VS(P,BD,ED,R,W) ;
+1 IF '$DATA(^AMHREC("C",P))
QUIT 0
+2 NEW S,X,Y,Z,C,A,B
+3 SET C=0
SET Y=""
SET Z=""
+4 SET S=$$FMADD^XLFDT(BD,-1)_".9999"
+5 FOR
SET S=$ORDER(^AMHREC("AF",P,S))
IF S=""!($PIECE(S,".")>ED)
QUIT
Begin DoDot:1
+6 SET X=0
FOR
SET X=$ORDER(^AMHREC("AF",P,S,X))
IF X'=+X
QUIT
Begin DoDot:2
+7 ;don't count no shows
IF $$NS(X)
QUIT
+8 IF R]""
IF $PIECE(^AMHREC(X,0),U,2)'=R
QUIT
+9 IF '$$ALLOWVI^AMHUTIL(DUZ,X)
QUIT
+10 IF W]""
Begin DoDot:3
+11 SET G=0
+12 SET A=0
FOR
SET A=$ORDER(^AMHRPROV("AD",X,A))
IF A'=+A!(G)
QUIT
IF $PIECE($GET(^AMHRPROV(A,0)),U)=W
SET G=1
End DoDot:3
IF 'G
QUIT
+13 ;Y is last date
SET C=C+1
SET Y=S
SET Z=X
+14 QUIT
End DoDot:2
+15 QUIT
End DoDot:1
+16 QUIT C_U_Y_U_Z
NS(V) ;
+1 NEW H,I,J,K,DNKA
+2 SET DNKA=0
+3 SET H=0
FOR
SET H=$ORDER(^AMHRPRO("AD",V,H))
IF H'=+H!(DNKA)
QUIT
Begin DoDot:1
+4 IF $PIECE(^AMHPROB($PIECE(^AMHRPRO(H,0),U),0),U)=8
SET DNKA=1
QUIT
+5 IF $PIECE(^AMHPROB($PIECE(^AMHRPRO(H,0),U),0),U)=8.1
SET DNKA=1
QUIT
+6 IF $PIECE(^AMHPROB($PIECE(^AMHRPRO(H,0),U),0),U)=8.11
SET DNKA=1
QUIT
+7 IF $PIECE(^AMHPROB($PIECE(^AMHRPRO(H,0),U),0),U)=8.2
SET DNKA=1
QUIT
+8 IF $PIECE(^AMHPROB($PIECE(^AMHRPRO(H,0),U),0),U)=8.21
SET DNKA=1
QUIT
+9 IF $PIECE(^AMHPROB($PIECE(^AMHRPRO(H,0),U),0),U)=8.3
SET DNKA=1
QUIT
+10 QUIT
End DoDot:1
+11 QUIT DNKA
PRINT ;
+1 SET AMH80D="-------------------------------------------------------------------------------"
+2 SET AMHPG=0
DO HEAD
+3 IF '$DATA(^XTMP("AMHRC4",AMHJOB,AMHBTH,"HITS"))
WRITE !!,"NO PATIENTS TO REPORT"
GOTO DONE
+4 SET DFN=""
KILL AMHQ
+5 SET AMHNAME=""
FOR
SET AMHNAME=$ORDER(^XTMP("AMHRC4",AMHJOB,AMHBTH,"HITS",AMHNAME))
IF AMHNAME=""!($DATA(AMHQ))
QUIT
Begin DoDot:1
+6 SET DFN=0
FOR
SET DFN=$ORDER(^XTMP("AMHRC4",AMHJOB,AMHBTH,"HITS",AMHNAME,DFN))
IF DFN'=+DFN!($DATA(AMHQ))
QUIT
DO PRN
End DoDot:1
+7 IF $DATA(AMHQ)
GOTO DONE
+8 WRITE !!,"Total Number of Patients: ",AMHPCNT,!
DONE ;
+1 KILL ^XTMP("AMHRC4",AMHJOB,AMHBTH),AMHJOB,AMHBTH
+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 WRITE ?38,$PIECE(^XTMP("AMHRC4",AMHJOB,AMHBTH,"HITS",AMHNAME,DFN),U,1)
+6 WRITE ?45,$$D($PIECE(^XTMP("AMHRC4",AMHJOB,AMHBTH,"HITS",AMHNAME,DFN),U,3))
+7 SET V=$PIECE(^XTMP("AMHRC4",AMHJOB,AMHBTH,"HITS",AMHNAME,DFN),U,2)
+8 WRITE ?56,$$LASTDX(V)
+9 WRITE ?65,$EXTRACT($$PPNAME^AMHUTIL(V),1,14)
+10 QUIT
LASTDX(V) ;
+1 ;get last pov
+2 NEW X
+3 SET X=$ORDER(^AMHRPRO("AD",V,0))
+4 IF X=""
QUIT ""
+5 QUIT $$VAL^XBDIQ1(9002011.01,X,.01)
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 SET X="PATIENTS SEEN AT LEAST "_AMHDAYS_" TIMES WITH NO CASE OPEN DATE"
WRITE $$CJ^XLFSTR(X,80),!
+6 SET X="VISIT DATE RANGE: "_$$FMTE^XLFDT(AMHBD)_" to "_$$FMTE^XLFDT(AMHED)
WRITE $$CJ^XLFSTR(X,80),!
+7 IF AMHPROG]""
SET X="VISITS TO PROGRAM: "_$$EXTSET^XBFUNC(9002011,.02,AMHPROG)
WRITE !,$$CTR(X,80)
+8 WRITE !,"PATIENT NAME",?18,"CHART",?25,"SEX",?31,"DOB",?38,"#",?45,"LAST VISIT",?56,"LAST",?63,"PROVIDER"
+9 WRITE !?18,"NUMBER",?38,"VISITS",?56,"DX"
+10 WRITE !,$$REPEAT^XLFSTR("-",80),!
+11 QUIT
D(D) ;
+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 ;----------
