- 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
