BCHRLP1 ; IHS/CMI/LAB - CONT OF BCHRLP ;
;;2.0;IHS RPMS CHR SYSTEM;;OCT 23, 2012;Build 27
;IHS/CMI/LAB - tmp to xtmp
;
;
COVPAGE ;EP
;W:$D(IOF) @IOF
W:IOST["C-" @IOF
W !?5,"RPMS/CHR-PCC ",$S(BCHPTVS="P":"PATIENT",1:"CHR RECORD")," ",$S(BCHCTYP="D":"LISTING",1:"COUNT")
W !!,"REPORT REQUESTED BY: ",$P(^VA(200,DUZ,0),U)
W !,$$CTR^BCHRLU($$LOC^BCHRLU),!
W !!,"The following report contains a ",$S(BCHPTVS="V":"CHR Record",1:"Patient")," report based on the",!,"following criteria:",!
SHOW ;
W !,$S(BCHPTVS="P":"PATIENT",1:"VISIT")," Selection Criteria"
I $G(BCHREGN)]"" W !!,"PATIENTS: ",BCHREGN
I $D(BCHRDTR),$D(BCHBDD) W !!?6,"Date of Service range: ",BCHBDD," to ",BCHEDD,!
W:BCHTYPE="D" !!?6,"Date of Service range: ",BCHBDD," to ",BCHEDD,!
W:BCHTYPE="S" !!?6,"Search Template: ",$P(^DIBT(BCHSEAT,0),U),!
I '$D(^BCHTRPT(BCHRPT,11)) G SHOWP
S BCHI=0 F S BCHI=$O(^BCHTRPT(BCHRPT,11,BCHI)) Q:BCHI'=+BCHI D
.I $Y>(IOSL-5) D PAUSE^BCHRL01 W @IOF
.W !?6,$P(^BCHSORT(BCHI,0),U),": "
.S BCHY=0,C=0 K BCHQ F S BCHY=$O(^BCHTRPT(BCHRPT,11,BCHI,11,"B",BCHY)) S C=C+1 Q:BCHY=""!($D(BCHQ)) W:C'=1&(BCHY'="") " ; " S X=BCHY X:$D(^BCHSORT(BCHI,2)) ^(2) W X
K BCHQ
SHOWP ;
I BCHCTYP="T" D COUNT Q
I BCHCTYP="S" D I 1
.I $Y>(IOSL-6) D PAUSE^BCHRL01 W @IOF
.W !!,"Report will contain sub-totals by ",$P(^BCHSORT(BCHSORT,0),U),"."
.I '$D(^XTMP("BCHRL",BCHJOB,BCHBTH)) W !!,$S(BCHPTVS="V":"NO VISITS",1:"NO PATIENTS")_" TO REPORT.",! D PAUSE^BCHRL01 W:$D(IOF) @IOF
.Q
I BCHCTYP'="D" D PAUSE^BCHRL01 W:$D(IOF) @IOF Q
I $Y>(IOSL-4) D PAUSE^BCHRL01 W @IOF
W !!,"PRINT Field Selection"
I '$D(^BCHTRPT(BCHRPT,12)) G PAUSE
S BCHI=0 F S BCHI=$O(^BCHTRPT(BCHRPT,12,BCHI)) Q:BCHI'=+BCHI S BCHCRIT=$P(^BCHTRPT(BCHRPT,12,BCHI,0),U) D
.I $Y>(IOSL-4) D PAUSE^BCHRL01 W:$D(IOF) @IOF
.W !?6,$P(^BCHSORT(BCHCRIT,0),U)," (" S X=$O(^BCHTRPT(BCHRPT,12,"B",BCHCRIT,"")) W $P(^BCHTRPT(BCHRPT,12,X,0),U,2),")"
I $Y>(IOSL-4) D PAUSE^BCHRL01 W:$D(IOF) @IOF
W !?10," TOTAL column width: ",BCHTCW
Q:'$G(BCHSORT)
I $Y>(IOSL-4) D PAUSE^BCHRL01 W:$D(IOF) @IOF
W !!?6,$S(BCHPTVS="V":"Records",1:"Patients")," will be sorted by: ",$P(^BCHSORT(BCHSORT,0),U),!
I $Y>(IOSL-4) D PAUSE^BCHRL01 W:$D(IOF) @IOF
I $G(BCHSPAG) W !?6,"Each ",$P(^BCHSORT(BCHSORT,0),U)," will be on a separate page.",!
I '$D(^XTMP("BCHRL",BCHJOB,BCHBTH)) W !!,$S(BCHPTVS="V":"NO VISITS",1:"NO PATIENTS")_" TO REPORT.",!
Q
PAUSE ;
D PAUSE^BCHRL01 W:IOST["C-" @IOF
;D PAUSE^BCHRL01 W:$D(IOF) @IOF
Q
COUNT ;if COUNTING entries only
I $Y>(IOSL-5) D PAUSE^BCHRL01 W:$D(IOF) @IOF
I '$D(^XTMP("BCHRL",BCHJOB,BCHBTH)) W !!!,$S(BCHPTVS="V":"NO VISITS",1:"NO PATIENTS")_" TO REPORT.",!
I $D(BCHRCNT),BCHPTVS="V" W !!!,"Total COUNT of ",$S(BCHPTVS="P":"Patients",1:"Records"),": ",BCHRCNT
I $D(BCHPTCT),BCHPTVS="P" W !!!,"Total COUNT of ",$S(BCHPTVS="P":"Patients",1:"Records"),": ",BCHPTCT
Q
WP ;EP - Entry point to print wp fields pass node in BCHNODE
;PASS FILE IN BCHFILE, ENTRY IN BCHDA
K ^UTILITY($J,"W")
S BCHG=^DIC(BCHFILE,0,"GL"),BCHG=BCHG_BCHDA_",BCHX)"
S DIWL=1,DIWR=$P(^BCHTRPT(BCHRPT,12,BCHI,0),U,2) F S BCHX=$O(@BCHG) Q:BCHX'=+BCHX D
.S Y=BCHG_",0)" S X=@Y D ^DIWP
.Q
S Z=0 F S Z=$O(^UTILITY($J,"W",DIWL,Z)) Q:Z'=+Z S BCHPCNT=BCHPCNT+1,BCHPRNM(BCHPCNT)=^UTILITY($J,"W",DIWL,Z,0)
K DIWL,DIWR,DIWF,Z
K ^UTILITY($J,"W"),BCHNODE,BCHFILE,BCHDA
Q
BCHRLP1 ; IHS/CMI/LAB - CONT OF BCHRLP ;
+1 ;;2.0;IHS RPMS CHR SYSTEM;;OCT 23, 2012;Build 27
+2 ;IHS/CMI/LAB - tmp to xtmp
+3 ;
+4 ;
COVPAGE ;EP
+1 ;W:$D(IOF) @IOF
+2 IF IOST["C-"
WRITE @IOF
+3 WRITE !?5,"RPMS/CHR-PCC ",$SELECT(BCHPTVS="P":"PATIENT",1:"CHR RECORD")," ",$SELECT(BCHCTYP="D":"LISTING",1:"COUNT")
+4 WRITE !!,"REPORT REQUESTED BY: ",$PIECE(^VA(200,DUZ,0),U)
+5 WRITE !,$$CTR^BCHRLU($$LOC^BCHRLU),!
+6 WRITE !!,"The following report contains a ",$SELECT(BCHPTVS="V":"CHR Record",1:"Patient")," report based on the",!,"following criteria:",!
SHOW ;
+1 WRITE !,$SELECT(BCHPTVS="P":"PATIENT",1:"VISIT")," Selection Criteria"
+2 IF $GET(BCHREGN)]""
WRITE !!,"PATIENTS: ",BCHREGN
+3 IF $DATA(BCHRDTR)
IF $DATA(BCHBDD)
WRITE !!?6,"Date of Service range: ",BCHBDD," to ",BCHEDD,!
+4 IF BCHTYPE="D"
WRITE !!?6,"Date of Service range: ",BCHBDD," to ",BCHEDD,!
+5 IF BCHTYPE="S"
WRITE !!?6,"Search Template: ",$PIECE(^DIBT(BCHSEAT,0),U),!
+6 IF '$DATA(^BCHTRPT(BCHRPT,11))
GOTO SHOWP
+7 SET BCHI=0
FOR
SET BCHI=$ORDER(^BCHTRPT(BCHRPT,11,BCHI))
IF BCHI'=+BCHI
QUIT
Begin DoDot:1
+8 IF $Y>(IOSL-5)
DO PAUSE^BCHRL01
WRITE @IOF
+9 WRITE !?6,$PIECE(^BCHSORT(BCHI,0),U),": "
+10 SET BCHY=0
SET C=0
KILL BCHQ
FOR
SET BCHY=$ORDER(^BCHTRPT(BCHRPT,11,BCHI,11,"B",BCHY))
SET C=C+1
IF BCHY=""!($DATA(BCHQ))
QUIT
IF C'=1&(BCHY'="")
WRITE " ; "
SET X=BCHY
IF $DATA(^BCHSORT(BCHI,2))
XECUTE ^(2)
WRITE X
End DoDot:1
+11 KILL BCHQ
SHOWP ;
+1 IF BCHCTYP="T"
DO COUNT
QUIT
+2 IF BCHCTYP="S"
Begin DoDot:1
+3 IF $Y>(IOSL-6)
DO PAUSE^BCHRL01
WRITE @IOF
+4 WRITE !!,"Report will contain sub-totals by ",$PIECE(^BCHSORT(BCHSORT,0),U),"."
+5 IF '$DATA(^XTMP("BCHRL",BCHJOB,BCHBTH))
WRITE !!,$SELECT(BCHPTVS="V":"NO VISITS",1:"NO PATIENTS")_" TO REPORT.",!
DO PAUSE^BCHRL01
IF $DATA(IOF)
WRITE @IOF
+6 QUIT
End DoDot:1
IF 1
+7 IF BCHCTYP'="D"
DO PAUSE^BCHRL01
IF $DATA(IOF)
WRITE @IOF
QUIT
+8 IF $Y>(IOSL-4)
DO PAUSE^BCHRL01
WRITE @IOF
+9 WRITE !!,"PRINT Field Selection"
+10 IF '$DATA(^BCHTRPT(BCHRPT,12))
GOTO PAUSE
+11 SET BCHI=0
FOR
SET BCHI=$ORDER(^BCHTRPT(BCHRPT,12,BCHI))
IF BCHI'=+BCHI
QUIT
SET BCHCRIT=$PIECE(^BCHTRPT(BCHRPT,12,BCHI,0),U)
Begin DoDot:1
+12 IF $Y>(IOSL-4)
DO PAUSE^BCHRL01
IF $DATA(IOF)
WRITE @IOF
+13 WRITE !?6,$PIECE(^BCHSORT(BCHCRIT,0),U)," ("
SET X=$ORDER(^BCHTRPT(BCHRPT,12,"B",BCHCRIT,""))
WRITE $PIECE(^BCHTRPT(BCHRPT,12,X,0),U,2),")"
End DoDot:1
+14 IF $Y>(IOSL-4)
DO PAUSE^BCHRL01
IF $DATA(IOF)
WRITE @IOF
+15 WRITE !?10," TOTAL column width: ",BCHTCW
+16 IF '$GET(BCHSORT)
QUIT
+17 IF $Y>(IOSL-4)
DO PAUSE^BCHRL01
IF $DATA(IOF)
WRITE @IOF
+18 WRITE !!?6,$SELECT(BCHPTVS="V":"Records",1:"Patients")," will be sorted by: ",$PIECE(^BCHSORT(BCHSORT,0),U),!
+19 IF $Y>(IOSL-4)
DO PAUSE^BCHRL01
IF $DATA(IOF)
WRITE @IOF
+20 IF $GET(BCHSPAG)
WRITE !?6,"Each ",$PIECE(^BCHSORT(BCHSORT,0),U)," will be on a separate page.",!
+21 IF '$DATA(^XTMP("BCHRL",BCHJOB,BCHBTH))
WRITE !!,$SELECT(BCHPTVS="V":"NO VISITS",1:"NO PATIENTS")_" TO REPORT.",!
+22 QUIT
PAUSE ;
+1 DO PAUSE^BCHRL01
IF IOST["C-"
WRITE @IOF
+2 ;D PAUSE^BCHRL01 W:$D(IOF) @IOF
+3 QUIT
COUNT ;if COUNTING entries only
+1 IF $Y>(IOSL-5)
DO PAUSE^BCHRL01
IF $DATA(IOF)
WRITE @IOF
+2 IF '$DATA(^XTMP("BCHRL",BCHJOB,BCHBTH))
WRITE !!!,$SELECT(BCHPTVS="V":"NO VISITS",1:"NO PATIENTS")_" TO REPORT.",!
+3 IF $DATA(BCHRCNT)
IF BCHPTVS="V"
WRITE !!!,"Total COUNT of ",$SELECT(BCHPTVS="P":"Patients",1:"Records"),": ",BCHRCNT
+4 IF $DATA(BCHPTCT)
IF BCHPTVS="P"
WRITE !!!,"Total COUNT of ",$SELECT(BCHPTVS="P":"Patients",1:"Records"),": ",BCHPTCT
+5 QUIT
WP ;EP - Entry point to print wp fields pass node in BCHNODE
+1 ;PASS FILE IN BCHFILE, ENTRY IN BCHDA
+2 KILL ^UTILITY($JOB,"W")
+3 SET BCHG=^DIC(BCHFILE,0,"GL")
SET BCHG=BCHG_BCHDA_",BCHX)"
+4 SET DIWL=1
SET DIWR=$PIECE(^BCHTRPT(BCHRPT,12,BCHI,0),U,2)
FOR
SET BCHX=$ORDER(@BCHG)
IF BCHX'=+BCHX
QUIT
Begin DoDot:1
+5 SET Y=BCHG_",0)"
SET X=@Y
DO ^DIWP
+6 QUIT
End DoDot:1
+7 SET Z=0
FOR
SET Z=$ORDER(^UTILITY($JOB,"W",DIWL,Z))
IF Z'=+Z
QUIT
SET BCHPCNT=BCHPCNT+1
SET BCHPRNM(BCHPCNT)=^UTILITY($JOB,"W",DIWL,Z,0)
+8 KILL DIWL,DIWR,DIWF,Z
+9 KILL ^UTILITY($JOB,"W"),BCHNODE,BCHFILE,BCHDA
+10 QUIT
