- 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
