AMHRLP1 ; IHS/CMI/LAB - CONT OF AMHRLP ;
;;4.0;IHS BEHAVIORAL HEALTH;;MAY 14, 2010
;
;
COVPAGE ;EP
W:$D(IOF) @IOF
I AMHPTVS="S" W !?5,"Listing of Suicide Forms by Selected Variables"
I AMHPTVS'="S" W !?5,"BEHAVIORAL HEALTH ",AMHPTTX," ",$S(AMHCTYP="D":"LISTING",1:"COUNT")
W !!,"REPORT REQUESTED BY: ",$P(^VA(200,DUZ,0),U)
W !!,"The following report contains a ",AMHPTTX," report based on the",!,"following item:",!
SHOW ;
W !,AMHPTTX," Selection Criteria"
I $D(AMHRDTR),$D(AMHBDD) W !!?6,"Encounter Date range: ",AMHBDD," to ",AMHEDD,!
I AMHPTVS'="S" W:AMHTYPE="D" !!?6,"Encounter Date range: ",AMHBDD," to ",AMHEDD,!
W:AMHTYPE="S" !!?6,"Search Template: ",$P(^DIBT(AMHSEAT,0),U),!
I '$D(^AMHTRPT(AMHRPT,11)) G SHOWP
S AMHI=0 F S AMHI=$O(^AMHTRPT(AMHRPT,11,AMHI)) Q:AMHI'=+AMHI D
.I $Y>(IOSL-5) D PAUSE^AMHRL01 W @IOF
.W !?6,$P(^AMHSORT(AMHI,0),U),": "
.K AMHQ S AMHY=0,C=0 K AMHQ F S AMHY=$O(^AMHTRPT(AMHRPT,11,AMHI,11,"B",AMHY)) S C=C+1 W:C'=1&(AMHY'="") " ; " Q:AMHY=""!($D(AMHQ)) S X=AMHY X:$D(^AMHSORT(AMHI,2)) ^(2) W X
K AMHQ
SHOWP ;
I AMHCTYP="F" W !!,"FLAT FILE BEING GENERATED: ",AMHFILE,!! W:'$D(ZTQUEUED) "HOLD ON......" Q
I AMHCTYP="T" D COUNT Q
I AMHCTYP="S" D I 1
.I $Y>(IOSL-6) D PAUSE^AMHRL01 W @IOF
.W !!,"Report will contain sub-totals by ",$P(^AMHSORT(AMHSORT,0),U),"."
.I '$D(^XTMP("AMHRL",AMHJOB,AMHBTH)) W !!,$S(AMHPTVS="S":"NO SUICIDE FORMS",AMHPTVS="V":"NO VISITS",1:"NO PATIENTS")_" TO REPORT.",! D PAUSE^AMHRL01 W:$D(IOF) @IOF
.Q
I AMHCTYP'="D" D PAUSE^AMHRL01 W:$D(IOF) @IOF Q
I $Y>(IOSL-4) D PAUSE^AMHRL01 W @IOF
W !!,"PRINT Field Selection"
I '$D(^AMHTRPT(AMHRPT,12)) G PAUSE
S AMHI=0 F S AMHI=$O(^AMHTRPT(AMHRPT,12,AMHI)) Q:AMHI'=+AMHI S AMHCRIT=$P(^AMHTRPT(AMHRPT,12,AMHI,0),U) D
.I $Y>(IOSL-4) D PAUSE^AMHRL01 W:$D(IOF) @IOF
.W !?6,$P(^AMHSORT(AMHCRIT,0),U)," (" S X=$O(^AMHTRPT(AMHRPT,12,"B",AMHCRIT,"")) W $P(^AMHTRPT(AMHRPT,12,X,0),U,2),")"
I $Y>(IOSL-4) D PAUSE^AMHRL01 W:$D(IOF) @IOF
W !?10," TOTAL column width: ",AMHTCW
Q:'$G(AMHSORT)
I $Y>(IOSL-4) D PAUSE^AMHRL01 W:$D(IOF) @IOF
W !!?6,AMHPTTS," will be sorted by: ",$P(^AMHSORT(AMHSORT,0),U),!
I $Y>(IOSL-4) D PAUSE^AMHRL01 W:$D(IOF) @IOF
I $G(AMHSPAG) W !?6,"Each ",$P(^AMHSORT(AMHSORT,0),U)," will be on a separate page.",!
I '$D(^XTMP("AMHRL",AMHJOB,AMHBTH)) W !!,$S(AMHPTVS="S":"NO SUICIDE FORMS",AMHPTVS="V":"NO VISITS",1:"NO PATIENTS")_" TO REPORT.",!
PAUSE D PAUSE^AMHRL01 W:$D(IOF) @IOF
Q
COUNT ;if COUNTING entries only
I $Y>(IOSL-5) D PAUSE^AMHRL01 W:$D(IOF) @IOF
I '$D(^XTMP("AMHRL",AMHJOB,AMHBTH)) W !!!,$S(AMHPTVS="S":"NO SUICIDE FORMS",AMHPTVS="V":"NO VISITS",1:"NO PATIENTS")_" TO REPORT.",!
I $D(AMHRCNT),(AMHPTVS="V"!(AMHPTVS="S")) W !!!,"Total COUNT of ",AMHPTTS,": ",AMHRCNT
I $D(AMHPTCT),(AMHPTVS="P") W !!!,"Total COUNT of ",$S(AMHPTVS="P":"Patients",1:"Visits"),": ",AMHPTCT
Q
WP ;EP - Entry point to print wp fields pass node in AMHNODE
;PASS FILE IN AMHFILE, ENTRY IN AMHDA
K ^UTILITY($J,"W")
S AMHRLX=0
S AMHG1=^DIC(AMHFILE,0,"GL"),AMHG=AMHG1_AMHDA_","_AMHNODE_",AMHRLX)",AMHGR=AMHG1_AMHDA_","_AMHNODE_",AMHRLX"
S DIWL=1,DIWR=$P(^AMHTRPT(AMHRPT,12,AMHI,0),U,2) F S AMHRLX=$O(@AMHG) Q:AMHRLX'=+AMHRLX D
.S Y=AMHGR_",0)" S X=@Y D ^DIWP
.Q
S Z=0 F S Z=$O(^UTILITY($J,"W",DIWL,Z)) Q:Z'=+Z S AMHPCNT=AMHPCNT+1,AMHPRNM(AMHPCNT)=^UTILITY($J,"W",DIWL,Z,0)
S AMHPCNT=AMHPCNT+1
K DIWL,DIWR,DIWF,Z
K ^UTILITY($J,"W"),AMHNODE,AMHFILE,AMHDA,AMHG1,AMHGR,AMHRLX
Q
WPS ;EP
S Z=0 F S Z=$O(^UTILITY($J,"W",DIWL,Z)) Q:Z'=+Z S AMHPCNT=AMHPCNT+1,AMHPRNM(AMHPCNT)=^UTILITY($J,"W",DIWL,Z,0)
K DIWL,DIWR,DIWF,Z
K ^UTILITY($J,"W"),AMHNODE,AMHFILE,AMHDA
Q
AMHRLP1 ; IHS/CMI/LAB - CONT OF AMHRLP ;
+1 ;;4.0;IHS BEHAVIORAL HEALTH;;MAY 14, 2010
+2 ;
+3 ;
COVPAGE ;EP
+1 IF $DATA(IOF)
WRITE @IOF
+2 IF AMHPTVS="S"
WRITE !?5,"Listing of Suicide Forms by Selected Variables"
+3 IF AMHPTVS'="S"
WRITE !?5,"BEHAVIORAL HEALTH ",AMHPTTX," ",$SELECT(AMHCTYP="D":"LISTING",1:"COUNT")
+4 WRITE !!,"REPORT REQUESTED BY: ",$PIECE(^VA(200,DUZ,0),U)
+5 WRITE !!,"The following report contains a ",AMHPTTX," report based on the",!,"following item:",!
SHOW ;
+1 WRITE !,AMHPTTX," Selection Criteria"
+2 IF $DATA(AMHRDTR)
IF $DATA(AMHBDD)
WRITE !!?6,"Encounter Date range: ",AMHBDD," to ",AMHEDD,!
+3 IF AMHPTVS'="S"
IF AMHTYPE="D"
WRITE !!?6,"Encounter Date range: ",AMHBDD," to ",AMHEDD,!
+4 IF AMHTYPE="S"
WRITE !!?6,"Search Template: ",$PIECE(^DIBT(AMHSEAT,0),U),!
+5 IF '$DATA(^AMHTRPT(AMHRPT,11))
GOTO SHOWP
+6 SET AMHI=0
FOR
SET AMHI=$ORDER(^AMHTRPT(AMHRPT,11,AMHI))
IF AMHI'=+AMHI
QUIT
Begin DoDot:1
+7 IF $Y>(IOSL-5)
DO PAUSE^AMHRL01
WRITE @IOF
+8 WRITE !?6,$PIECE(^AMHSORT(AMHI,0),U),": "
+9 KILL AMHQ
SET AMHY=0
SET C=0
KILL AMHQ
FOR
SET AMHY=$ORDER(^AMHTRPT(AMHRPT,11,AMHI,11,"B",AMHY))
SET C=C+1
IF C'=1&(AMHY'="")
WRITE " ; "
IF AMHY=""!($DATA(AMHQ))
QUIT
SET X=AMHY
IF $DATA(^AMHSORT(AMHI,2))
XECUTE ^(2)
WRITE X
End DoDot:1
+10 KILL AMHQ
SHOWP ;
+1 IF AMHCTYP="F"
WRITE !!,"FLAT FILE BEING GENERATED: ",AMHFILE,!!
IF '$DATA(ZTQUEUED)
WRITE "HOLD ON......"
QUIT
+2 IF AMHCTYP="T"
DO COUNT
QUIT
+3 IF AMHCTYP="S"
Begin DoDot:1
+4 IF $Y>(IOSL-6)
DO PAUSE^AMHRL01
WRITE @IOF
+5 WRITE !!,"Report will contain sub-totals by ",$PIECE(^AMHSORT(AMHSORT,0),U),"."
+6 IF '$DATA(^XTMP("AMHRL",AMHJOB,AMHBTH))
WRITE !!,$SELECT(AMHPTVS="S":"NO SUICIDE FORMS",AMHPTVS="V":"NO VISITS",1:"NO PATIENTS")_" TO REPORT.",!
DO PAUSE^AMHRL01
IF $DATA(IOF)
WRITE @IOF
+7 QUIT
End DoDot:1
IF 1
+8 IF AMHCTYP'="D"
DO PAUSE^AMHRL01
IF $DATA(IOF)
WRITE @IOF
QUIT
+9 IF $Y>(IOSL-4)
DO PAUSE^AMHRL01
WRITE @IOF
+10 WRITE !!,"PRINT Field Selection"
+11 IF '$DATA(^AMHTRPT(AMHRPT,12))
GOTO PAUSE
+12 SET AMHI=0
FOR
SET AMHI=$ORDER(^AMHTRPT(AMHRPT,12,AMHI))
IF AMHI'=+AMHI
QUIT
SET AMHCRIT=$PIECE(^AMHTRPT(AMHRPT,12,AMHI,0),U)
Begin DoDot:1
+13 IF $Y>(IOSL-4)
DO PAUSE^AMHRL01
IF $DATA(IOF)
WRITE @IOF
+14 WRITE !?6,$PIECE(^AMHSORT(AMHCRIT,0),U)," ("
SET X=$ORDER(^AMHTRPT(AMHRPT,12,"B",AMHCRIT,""))
WRITE $PIECE(^AMHTRPT(AMHRPT,12,X,0),U,2),")"
End DoDot:1
+15 IF $Y>(IOSL-4)
DO PAUSE^AMHRL01
IF $DATA(IOF)
WRITE @IOF
+16 WRITE !?10," TOTAL column width: ",AMHTCW
+17 IF '$GET(AMHSORT)
QUIT
+18 IF $Y>(IOSL-4)
DO PAUSE^AMHRL01
IF $DATA(IOF)
WRITE @IOF
+19 WRITE !!?6,AMHPTTS," will be sorted by: ",$PIECE(^AMHSORT(AMHSORT,0),U),!
+20 IF $Y>(IOSL-4)
DO PAUSE^AMHRL01
IF $DATA(IOF)
WRITE @IOF
+21 IF $GET(AMHSPAG)
WRITE !?6,"Each ",$PIECE(^AMHSORT(AMHSORT,0),U)," will be on a separate page.",!
+22 IF '$DATA(^XTMP("AMHRL",AMHJOB,AMHBTH))
WRITE !!,$SELECT(AMHPTVS="S":"NO SUICIDE FORMS",AMHPTVS="V":"NO VISITS",1:"NO PATIENTS")_" TO REPORT.",!
PAUSE DO PAUSE^AMHRL01
IF $DATA(IOF)
WRITE @IOF
+1 QUIT
COUNT ;if COUNTING entries only
+1 IF $Y>(IOSL-5)
DO PAUSE^AMHRL01
IF $DATA(IOF)
WRITE @IOF
+2 IF '$DATA(^XTMP("AMHRL",AMHJOB,AMHBTH))
WRITE !!!,$SELECT(AMHPTVS="S":"NO SUICIDE FORMS",AMHPTVS="V":"NO VISITS",1:"NO PATIENTS")_" TO REPORT.",!
+3 IF $DATA(AMHRCNT)
IF (AMHPTVS="V"!(AMHPTVS="S"))
WRITE !!!,"Total COUNT of ",AMHPTTS,": ",AMHRCNT
+4 IF $DATA(AMHPTCT)
IF (AMHPTVS="P")
WRITE !!!,"Total COUNT of ",$SELECT(AMHPTVS="P":"Patients",1:"Visits"),": ",AMHPTCT
+5 QUIT
WP ;EP - Entry point to print wp fields pass node in AMHNODE
+1 ;PASS FILE IN AMHFILE, ENTRY IN AMHDA
+2 KILL ^UTILITY($JOB,"W")
+3 SET AMHRLX=0
+4 SET AMHG1=^DIC(AMHFILE,0,"GL")
SET AMHG=AMHG1_AMHDA_","_AMHNODE_",AMHRLX)"
SET AMHGR=AMHG1_AMHDA_","_AMHNODE_",AMHRLX"
+5 SET DIWL=1
SET DIWR=$PIECE(^AMHTRPT(AMHRPT,12,AMHI,0),U,2)
FOR
SET AMHRLX=$ORDER(@AMHG)
IF AMHRLX'=+AMHRLX
QUIT
Begin DoDot:1
+6 SET Y=AMHGR_",0)"
SET X=@Y
DO ^DIWP
+7 QUIT
End DoDot:1
+8 SET Z=0
FOR
SET Z=$ORDER(^UTILITY($JOB,"W",DIWL,Z))
IF Z'=+Z
QUIT
SET AMHPCNT=AMHPCNT+1
SET AMHPRNM(AMHPCNT)=^UTILITY($JOB,"W",DIWL,Z,0)
+9 SET AMHPCNT=AMHPCNT+1
+10 KILL DIWL,DIWR,DIWF,Z
+11 KILL ^UTILITY($JOB,"W"),AMHNODE,AMHFILE,AMHDA,AMHG1,AMHGR,AMHRLX
+12 QUIT
WPS ;EP
+1 SET Z=0
FOR
SET Z=$ORDER(^UTILITY($JOB,"W",DIWL,Z))
IF Z'=+Z
QUIT
SET AMHPCNT=AMHPCNT+1
SET AMHPRNM(AMHPCNT)=^UTILITY($JOB,"W",DIWL,Z,0)
+2 KILL DIWL,DIWR,DIWF,Z
+3 KILL ^UTILITY($JOB,"W"),AMHNODE,AMHFILE,AMHDA
+4 QUIT
