AMHRP2P ; IHS/CMI/LAB - = print all visit report ;
;;4.0;IHS BEHAVIORAL HEALTH;;MAY 14, 2010
START ;
D NOW^%DTC S Y=X D DD^%DT S AMHDT=Y
S Y=AMHBD D DD^%DT S AMHBDD=Y S Y=AMHED D DD^%DT S AMHEDD=Y
S (AMHATOT,AMHSTOT,AMHFTOT,AMHPTOT,AMHPG)=0 D HEAD
K AMHQUIT
AREA ;
S AMHAREA="" F S AMHAREA=$O(^XTMP("AMHRP2",AMHJOB,AMHBTH,"RECORDS",AMHAREA)) Q:AMHAREA=""!($D(AMHQUIT)) D
.S (AMHATOT("R"),AMHATOT("AT"),AMHATOT("P"),AMHATOT("NS"))=0
.I $Y>(IOSL-4) D HEAD Q:$D(AMHQUIT)
.W !,"AREA: ",$P(^AUTTAREA(AMHAREA,0),U)
.D SU
.Q:$D(AMHQUIT)
.I $Y>(IOSL-5) D HEAD Q:$D(AMHQUIT)
.W !?43,"=======",?53,"=======",?62,"=======",?73,"=======",!
.W "AREA TOTAL:",?43,$J(AMHATOT("R"),7),?53,$J((AMHATOT("AT")/60),7,1),?62,$J(AMHATOT("P"),7),?73,$J(AMHATOT("NS"),7),!
DONE ;
D DONE^AMHLEIN,^AMHEKL
K ^XTMP("AMHRP2",AMHJOB,AMHBTH),AMHJOB,AMHBTH
Q
SU ;
S AMHSU="" F S AMHSU=$O(^XTMP("AMHRP2",AMHJOB,AMHBTH,"RECORDS",AMHAREA,AMHSU)) Q:AMHSU=""!($D(AMHQUIT)) D
.S (AMHSTOT("R"),AMHSTOT("AT"),AMHSTOT("P"),AMHSTOT("NS"))=0
.I $Y>(IOSL-4) D HEAD Q:$D(AMHQUIT)
.W !?2,"SERVICE UNIT: ",$P(^AUTTSU(AMHSU,0),U)
.D LOC
.Q:$D(AMHQUIT)
.I $Y>(IOSL-5) D HEAD Q:$D(AMHQUIT)
.W !?43,"=======",?53,"=======",?62,"=======",?73,"=======",!
.W ?2,"SU TOTAL:",?43,$J(AMHSTOT("R"),7),?53,$J((AMHSTOT("AT")/60),7,1),?62,$J(AMHSTOT("P"),7),?73,$J(AMHSTOT("NS"),7),!
Q
LOC ;
S AMHLOC="" F S AMHLOC=$O(^XTMP("AMHRP2",AMHJOB,AMHBTH,"RECORDS",AMHAREA,AMHSU,AMHLOC)) Q:AMHLOC=""!($D(AMHQUIT)) D
.S (AMHLTOT("R"),AMHLTOT("AT"),AMHLTOT("P"),AMHLTOT("NS"))=0
.I $Y>(IOSL-4) D HEAD Q:$D(AMHQUIT)
.W !?5,"FACILITY: ",$P(^DIC(4,AMHLOC,0),U)
.D PROV
.Q:$D(AMHQUIT)
.I $Y>(IOSL-5) D HEAD Q:$D(AMHQUIT)
.W !?43,"=======",?53,"=======",?62,"=======",?73,"=======",!
.W ?5,"FACILITY TOTAL:",?43,$J(AMHLTOT("R"),7),?53,$J((AMHLTOT("AT")/60),7,1),?62,$J(AMHLTOT("P"),7),?73,$J(AMHLTOT("NS"),7),!
Q
PROV ;
S AMHPROV="" F S AMHPROV=$O(^XTMP("AMHRP2",AMHJOB,AMHBTH,"RECORDS",AMHAREA,AMHSU,AMHLOC,AMHPROV)) Q:AMHPROV=""!($D(AMHQUIT)) D
.S (AMHPTOT("R"),AMHPTOT("AT"),AMHPTOT("P"),AMHPTOT("NS"))=0
.I $Y>(IOSL-4) D HEAD Q:$D(AMHQUIT)
.W !?8,"PROVIDER: ",AMHPROV
.D ACT
.Q:$D(AMHQUIT)
.I $Y>(IOSL-5) D HEAD Q:$D(AMHQUIT)
.W !?43,"=======",?53,"=======",?62,"=======",?73,"=======",!
.W ?8,"PROVIDER TOTAL:",?43,$J(AMHPTOT("R"),7),?53,$J((AMHPTOT("AT")/60),7,1),?62,$J(AMHPTOT("P"),7),?73,$J(AMHPTOT("NS"),7),!
.;W ?8,"PROVIDER TOTAL:",?43,$J(AMHPTOT("R"),7),?53,$J(AMHPTOT("AT"),7),?62,$J(AMHPTOT("P"),7),!
Q
ACT ;
S AMHACT="" F S AMHACT=$O(^XTMP("AMHRP2",AMHJOB,AMHBTH,"RECORDS",AMHAREA,AMHSU,AMHLOC,AMHPROV,AMHACT)) Q:AMHACT=""!($D(AMHQUIT)) D
.I $Y>(IOSL-4) D HEAD Q:$D(AMHQUIT)
.S AMHREC=$P(^XTMP("AMHRP2",AMHJOB,AMHBT,"RECORDS",AMHAREA,AMHSU,AMHLOC,AMHPROV,AMHACT),U),AMHAT=$P(^(AMHACT),U,2),AMHPAT=$P(^(AMHACT),U,3),AMHNS=$P(^(AMHACT),U,4)
.W !?11,$E(AMHACT,1,29),?43,$J(AMHREC,7),?53,$J((AMHAT/60),7,1),?62,$J(AMHPAT,7),?73,$J(AMHNS,7)
.S AMHATOT("R")=AMHATOT("R")+AMHREC,AMHSTOT("R")=AMHSTOT("R")+AMHREC,AMHLTOT("R")=AMHLTOT("R")+AMHREC,AMHPTOT("R")=AMHPTOT("R")+AMHREC
.S AMHATOT("AT")=AMHATOT("AT")+AMHAT,AMHSTOT("AT")=AMHSTOT("AT")+AMHAT,AMHLTOT("AT")=AMHLTOT("AT")+AMHAT,AMHPTOT("AT")=AMHPTOT("AT")+AMHAT
.S AMHATOT("P")=AMHATOT("P")+AMHPAT,AMHSTOT("P")=AMHSTOT("P")+AMHPAT,AMHLTOT("P")=AMHLTOT("P")+AMHPAT,AMHPTOT("P")=AMHPTOT("P")+AMHPAT
.S AMHATOT("NS")=AMHATOT("NS")+AMHNS,AMHSTOT("NS")=AMHSTOT("NS")+AMHNS,AMHLTOT("NS")=AMHLTOT("NS")+AMHNS,AMHPTOT("NS")=AMHPTOT("NS")+AMHNS
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 AMHQUIT="" Q
HEAD1 ;
W:$D(IOF) @IOF S AMHPG=AMHPG+1
W !?13,"********** CONFIDENTIAL PATIENT INFORMATION **********"
W !,$P(^VA(200,DUZ,0),U,2),?58,AMHDT,?62,"Page ",AMHPG,!
I AMHPROG]"" S AMHLENG=28+$L($$EXTSET^XBFUNC(9002011,.02,AMHPROG))
E S AMHLENG=59
W ?((80-AMHLENG)\2),"ACTIVITY REPORT FOR ",$S(AMHPROG="S":"SOCIAL SERVICES",AMHPROG="M":"MENTAL HEALTH",AMHPROG="C":"CHEMICAL DEPENDENCY or A/SA",1:"ALL PROGRAMS (MH,SS,CD,OTHER)")," PROGRAM",!
W ?17,"RECORD DATES: ",AMHBDD," TO ",AMHEDD,!
W "# PATS is the total number of unique, identifiable patients when",!,"a patient name was entered on the record. # served is a tally of the ",!,"number served data value.",!
W !?43,"# RECS",?53,"ACT TIME",?63,"# PATS",?72,"# SERVED",!?53,"(hrs)"
W !,$TR($J(" ",80)," ","-")
Q
AMHRP2P ; IHS/CMI/LAB - = print all visit report ;
+1 ;;4.0;IHS BEHAVIORAL HEALTH;;MAY 14, 2010
START ;
+1 DO NOW^%DTC
SET Y=X
DO DD^%DT
SET AMHDT=Y
+2 SET Y=AMHBD
DO DD^%DT
SET AMHBDD=Y
SET Y=AMHED
DO DD^%DT
SET AMHEDD=Y
+3 SET (AMHATOT,AMHSTOT,AMHFTOT,AMHPTOT,AMHPG)=0
DO HEAD
+4 KILL AMHQUIT
AREA ;
+1 SET AMHAREA=""
FOR
SET AMHAREA=$ORDER(^XTMP("AMHRP2",AMHJOB,AMHBTH,"RECORDS",AMHAREA))
IF AMHAREA=""!($DATA(AMHQUIT))
QUIT
Begin DoDot:1
+2 SET (AMHATOT("R"),AMHATOT("AT"),AMHATOT("P"),AMHATOT("NS"))=0
+3 IF $Y>(IOSL-4)
DO HEAD
IF $DATA(AMHQUIT)
QUIT
+4 WRITE !,"AREA: ",$PIECE(^AUTTAREA(AMHAREA,0),U)
+5 DO SU
+6 IF $DATA(AMHQUIT)
QUIT
+7 IF $Y>(IOSL-5)
DO HEAD
IF $DATA(AMHQUIT)
QUIT
+8 WRITE !?43,"=======",?53,"=======",?62,"=======",?73,"=======",!
+9 WRITE "AREA TOTAL:",?43,$JUSTIFY(AMHATOT("R"),7),?53,$JUSTIFY((AMHATOT("AT")/60),7,1),?62,$JUSTIFY(AMHATOT("P"),7),?73,$JUSTIFY(AMHATOT("NS"),7),!
End DoDot:1
DONE ;
+1 DO DONE^AMHLEIN
DO ^AMHEKL
+2 KILL ^XTMP("AMHRP2",AMHJOB,AMHBTH),AMHJOB,AMHBTH
+3 QUIT
SU ;
+1 SET AMHSU=""
FOR
SET AMHSU=$ORDER(^XTMP("AMHRP2",AMHJOB,AMHBTH,"RECORDS",AMHAREA,AMHSU))
IF AMHSU=""!($DATA(AMHQUIT))
QUIT
Begin DoDot:1
+2 SET (AMHSTOT("R"),AMHSTOT("AT"),AMHSTOT("P"),AMHSTOT("NS"))=0
+3 IF $Y>(IOSL-4)
DO HEAD
IF $DATA(AMHQUIT)
QUIT
+4 WRITE !?2,"SERVICE UNIT: ",$PIECE(^AUTTSU(AMHSU,0),U)
+5 DO LOC
+6 IF $DATA(AMHQUIT)
QUIT
+7 IF $Y>(IOSL-5)
DO HEAD
IF $DATA(AMHQUIT)
QUIT
+8 WRITE !?43,"=======",?53,"=======",?62,"=======",?73,"=======",!
+9 WRITE ?2,"SU TOTAL:",?43,$JUSTIFY(AMHSTOT("R"),7),?53,$JUSTIFY((AMHSTOT("AT")/60),7,1),?62,$JUSTIFY(AMHSTOT("P"),7),?73,$JUSTIFY(AMHSTOT("NS"),7),!
End DoDot:1
+10 QUIT
LOC ;
+1 SET AMHLOC=""
FOR
SET AMHLOC=$ORDER(^XTMP("AMHRP2",AMHJOB,AMHBTH,"RECORDS",AMHAREA,AMHSU,AMHLOC))
IF AMHLOC=""!($DATA(AMHQUIT))
QUIT
Begin DoDot:1
+2 SET (AMHLTOT("R"),AMHLTOT("AT"),AMHLTOT("P"),AMHLTOT("NS"))=0
+3 IF $Y>(IOSL-4)
DO HEAD
IF $DATA(AMHQUIT)
QUIT
+4 WRITE !?5,"FACILITY: ",$PIECE(^DIC(4,AMHLOC,0),U)
+5 DO PROV
+6 IF $DATA(AMHQUIT)
QUIT
+7 IF $Y>(IOSL-5)
DO HEAD
IF $DATA(AMHQUIT)
QUIT
+8 WRITE !?43,"=======",?53,"=======",?62,"=======",?73,"=======",!
+9 WRITE ?5,"FACILITY TOTAL:",?43,$JUSTIFY(AMHLTOT("R"),7),?53,$JUSTIFY((AMHLTOT("AT")/60),7,1),?62,$JUSTIFY(AMHLTOT("P"),7),?73,$JUSTIFY(AMHLTOT("NS"),7),!
End DoDot:1
+10 QUIT
PROV ;
+1 SET AMHPROV=""
FOR
SET AMHPROV=$ORDER(^XTMP("AMHRP2",AMHJOB,AMHBTH,"RECORDS",AMHAREA,AMHSU,AMHLOC,AMHPROV))
IF AMHPROV=""!($DATA(AMHQUIT))
QUIT
Begin DoDot:1
+2 SET (AMHPTOT("R"),AMHPTOT("AT"),AMHPTOT("P"),AMHPTOT("NS"))=0
+3 IF $Y>(IOSL-4)
DO HEAD
IF $DATA(AMHQUIT)
QUIT
+4 WRITE !?8,"PROVIDER: ",AMHPROV
+5 DO ACT
+6 IF $DATA(AMHQUIT)
QUIT
+7 IF $Y>(IOSL-5)
DO HEAD
IF $DATA(AMHQUIT)
QUIT
+8 WRITE !?43,"=======",?53,"=======",?62,"=======",?73,"=======",!
+9 WRITE ?8,"PROVIDER TOTAL:",?43,$JUSTIFY(AMHPTOT("R"),7),?53,$JUSTIFY((AMHPTOT("AT")/60),7,1),?62,$JUSTIFY(AMHPTOT("P"),7),?73,$JUSTIFY(AMHPTOT("NS"),7),!
+10 ;W ?8,"PROVIDER TOTAL:",?43,$J(AMHPTOT("R"),7),?53,$J(AMHPTOT("AT"),7),?62,$J(AMHPTOT("P"),7),!
End DoDot:1
+11 QUIT
ACT ;
+1 SET AMHACT=""
FOR
SET AMHACT=$ORDER(^XTMP("AMHRP2",AMHJOB,AMHBTH,"RECORDS",AMHAREA,AMHSU,AMHLOC,AMHPROV,AMHACT))
IF AMHACT=""!($DATA(AMHQUIT))
QUIT
Begin DoDot:1
+2 IF $Y>(IOSL-4)
DO HEAD
IF $DATA(AMHQUIT)
QUIT
+3 SET AMHREC=$PIECE(^XTMP("AMHRP2",AMHJOB,AMHBT,"RECORDS",AMHAREA,AMHSU,AMHLOC,AMHPROV,AMHACT),U)
SET AMHAT=$PIECE(^(AMHACT),U,2)
SET AMHPAT=$PIECE(^(AMHACT),U,3)
SET AMHNS=$PIECE(^(AMHACT),U,4)
+4 WRITE !?11,$EXTRACT(AMHACT,1,29),?43,$JUSTIFY(AMHREC,7),?53,$JUSTIFY((AMHAT/60),7,1),?62,$JUSTIFY(AMHPAT,7),?73,$JUSTIFY(AMHNS,7)
+5 SET AMHATOT("R")=AMHATOT("R")+AMHREC
SET AMHSTOT("R")=AMHSTOT("R")+AMHREC
SET AMHLTOT("R")=AMHLTOT("R")+AMHREC
SET AMHPTOT("R")=AMHPTOT("R")+AMHREC
+6 SET AMHATOT("AT")=AMHATOT("AT")+AMHAT
SET AMHSTOT("AT")=AMHSTOT("AT")+AMHAT
SET AMHLTOT("AT")=AMHLTOT("AT")+AMHAT
SET AMHPTOT("AT")=AMHPTOT("AT")+AMHAT
+7 SET AMHATOT("P")=AMHATOT("P")+AMHPAT
SET AMHSTOT("P")=AMHSTOT("P")+AMHPAT
SET AMHLTOT("P")=AMHLTOT("P")+AMHPAT
SET AMHPTOT("P")=AMHPTOT("P")+AMHPAT
+8 SET AMHATOT("NS")=AMHATOT("NS")+AMHNS
SET AMHSTOT("NS")=AMHSTOT("NS")+AMHNS
SET AMHLTOT("NS")=AMHLTOT("NS")+AMHNS
SET AMHPTOT("NS")=AMHPTOT("NS")+AMHNS
End DoDot:1
+9 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 AMHQUIT=""
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),?58,AMHDT,?62,"Page ",AMHPG,!
+4 IF AMHPROG]""
SET AMHLENG=28+$LENGTH($$EXTSET^XBFUNC(9002011,.02,AMHPROG))
+5 IF '$TEST
SET AMHLENG=59
+6 WRITE ?((80-AMHLENG)\2),"ACTIVITY REPORT FOR ",$SELECT(AMHPROG="S":"SOCIAL SERVICES",AMHPROG="M":"MENTAL HEALTH",AMHPROG="C":"CHEMICAL DEPENDENCY or A/SA",1:"ALL PROGRAMS (MH,SS,CD,OTHER)")," PROGRAM",!
+7 WRITE ?17,"RECORD DATES: ",AMHBDD," TO ",AMHEDD,!
+8 WRITE "# PATS is the total number of unique, identifiable patients when",!,"a patient name was entered on the record. # served is a tally of the ",!,"number served data value.",!
+9 WRITE !?43,"# RECS",?53,"ACT TIME",?63,"# PATS",?72,"# SERVED",!?53,"(hrs)"
+10 WRITE !,$TRANSLATE($JUSTIFY(" ",80)," ","-")
+11 QUIT
