BMCRLP2 ; IHS/PHXAO/TMJ - PRINT REFERRAL REPORT ;
;;4.0;REFERRED CARE INFO SYSTEM;;JAN 09, 2006
;
DONE ;EP
D DONE^BMCRLP1
K ^XTMP("BMCRL",BMCJOB,BMCBT)
D DEL^BMCRL
K BMCBD,BMCSD,BMCED,BMCEDD,BMCBDD,BMCRPT,BMCHEAD,BMCLINE,BMCL,BMCRCNT,BMCI,BMCCRIT,BMCREF,BMCRREC,BMCJOB,BMCBT,BMCBTH,BMCQUIT,BMCHDR,BMCDASH,BMCLENG,BMCPCNT,BMCTCW,BMCODAT,BMCPG,AUPNDAYS,AUPNPAT,AUPNDOD,AUPNDOB,AUPNSEX
K BMCSORT,BMCSRT,BMCSORX,BMCFILE,BMCFIEL,BMCPRNT,BMCX,BMCTYPE,BMCFOUN,D0,J,K,L,BMCPRNM,BMCTEST,BMCSEAT,BMCLHDR,BMCFRST,BMCTST
Q
HEAD ;ENTRY POINT
I 'BMCPG 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 BMCQUIT="" Q
HEAD1 ;EP
W:$D(IOF) @IOF S BMCPG=BMCPG+1
I $G(BMCTITL)="" S BMCTEXT="PCC "_$S(BMCPTVS="R":"REFERRAL",1:"PATIENT")_" LISTING",BMCLENG=$L(BMCTEXT) W !?((BMCTCW-BMCLENG)/2),BMCTEXT,?(BMCTCW-8),"Page ",BMCPG
I $G(BMCTITL)]"" S BMCLENG=$L(BMCTITL) W !?((BMCTCW-BMCLENG)/2),BMCTITL,?(BMCTCW-8),"Page ",BMCPG
;I BMCTYPE="D" S BMCLENG=46 S:BMCTCW<BMCLENG BMCLENG=BMCTCW W !?((BMCTCW-BMCLENG)/2),"Referral Dates: ",BMCBDD," and ",BMCEDD,!
;I BMCTYPE="S" S BMCLENG=16+$L($P(^DIBT(BMCSEAT,0),U)) S:BMCTCW<BMCLENG BMCLENG=BMCTCW W !?((BMCTCW-BMCLENG)/2),"Search Template: ",$P(^DIBT(BMCSEAT,0),U),!
I $G(BMCCTYP)="N" S BMCLENG=$L(BMCSORV)+27+$L(^BMCTSORT(BMCNSRT,0),U) W !?((80-BMCLENG)/2),"BASIC STATISTICS FOR: ",$P(^BMCTSORT(BMCNSRT,0),U) W:BMCSORT=6 ! I BMCSORT'=6 W " BY ",BMCSORV,!
I $G(BMCCTYP)="S" S BMCLENG=$L(BMCSORV)+23 W !?((BMCTCW-BMCLENG)/2),$S(BMCPTVS="R":"REFERRAL",1:"PATIENT")," SUB-TOTALS BY: ",BMCSORV,!
I $G(BMCSPAG) S BMCLENG=$L(BMCSORV)+$L(BMCSRTR)+2 S:BMCTCW<BMCLENG BMCLENG=BMCTCW W !?((BMCTCW-BMCLENG)/2),BMCSORV,": ",BMCSRTR,!
I BMCHEAD]"" W !,BMCHEAD,!
I $G(BMCCTYP)="R" W !
W BMCDASH,!
I $G(BMCCTYP)="S" W !,BMCSORV,":"
Q
N ;EP
D HEAD
I '$D(^XTMP("BMCRL",BMCJOB,BMCBTH,"STATS")) W !!,"No records selected." Q
S BMCREF="" F S BMCREF=$O(^XTMP("BMCRL",BMCJOB,BMCBTH,"STATS",BMCREF)) Q:BMCREF=""!($D(BMCQUIT)) S BMCR=^XTMP("BMCRL",BMCJOB,BMCBTH,"STATS",BMCREF) D
.I $Y>(IOSL-10) D HEAD Q:$D(BMCQUIT)
.W !!?5,BMCREF
.W !!?10,"Total referrals selected",?45,$J($P(BMCR,U),12)
.W !?10,"Total referrals w/",$P(^BMCTSORT(BMCNSRT,0),U),?45,$J($P(BMCR,U,6),12)
.S X=$P(BMCR,U,2) I $P(^BMCTSORT(BMCNSRT,0),U,13) S X2="2$",X3=14 D COMMA^%DTC
.W !?10,"Sum",?45,$J(X,14)
.S X=$P(BMCR,U,3) I $P(^BMCTSORT(BMCNSRT,0),U,13) S X2="2$",X3=14 D COMMA^%DTC
.W !?10,"Mean",?45,$J(X,14,2)
.S X=$P(BMCR,U,5) I $P(^BMCTSORT(BMCNSRT,0),U,13) S X2="2$",X3=14 D COMMA^%DTC
.W !?10,"Maximum Value",?45,$J(X,14)
.S X=$P(BMCR,U,4) I $P(^BMCTSORT(BMCNSRT,0),U,13) S X2="2$",X3=14 D COMMA^%DTC
.W !?10,"Minimum Value",?45,$J(X,14)
.Q
I $Y>(IOSL-10) D HEAD
S BMCR=^XTMP("BMCRL",BMCJOB,BMCBTH,"STATS")
W !!?5,"TOTALS"
W !!?10,"Total referrals selected",?45,$J($P(BMCR,U),12)
W !?10,"Total referrals w/",$P(^BMCTSORT(BMCNSRT,0),U),?45,$J($P(BMCR,U,6),12)
S X=$P(BMCR,U,2) I $P(^BMCTSORT(BMCNSRT,0),U,13) S X2="2$",X3=14 D COMMA^%DTC
W !?10,"Sum",?45,$J(X,14)
S X=$P(BMCR,U,3) I $P(^BMCTSORT(BMCNSRT,0),U,13) S X2="2$",X3=14 D COMMA^%DTC
W !?10,"Mean",?45,$J(X,14,2)
S X=$P(BMCR,U,5) I $P(^BMCTSORT(BMCNSRT,0),U,13) S X2="2$",X3=14 D COMMA^%DTC
W !?10,"Maximum Value",?45,$J(X,14)
S X=$P(BMCR,U,4) I $P(^BMCTSORT(BMCNSRT,0),U,13) S X2="2$",X3=14 D COMMA^%DTC
W !?10,"Minimum Value",?45,$J(X,14)
K BMCR,BMCREF
Q
R ;EP record display
D HEAD
D EP^BMCRD(BMCREF)
S BMCX=0 F S BMCX=$O(^TMP("BMCRDSP",$J,BMCX)) Q:BMCX'=+BMCX!($D(BMCQUIT)) D
.I $Y>(IOSL-5) D HEAD Q:$D(BMCQUIT)
.W !,^TMP("BMCRDSP",$J,BMCX,0)
.Q
Q
BMCRLP2 ; IHS/PHXAO/TMJ - PRINT REFERRAL REPORT ;
+1 ;;4.0;REFERRED CARE INFO SYSTEM;;JAN 09, 2006
+2 ;
DONE ;EP
+1 DO DONE^BMCRLP1
+2 KILL ^XTMP("BMCRL",BMCJOB,BMCBT)
+3 DO DEL^BMCRL
+4 KILL BMCBD,BMCSD,BMCED,BMCEDD,BMCBDD,BMCRPT,BMCHEAD,BMCLINE,BMCL,BMCRCNT,BMCI,BMCCRIT,BMCREF,BMCRREC,BMCJOB,BMCBT,BMCBTH,BMCQUIT,BMCHDR,BMCDASH,BMCLENG,BMCPCNT,BMCTCW,BMCODAT,BMCPG,AUPNDAYS,AUPNPAT,AUPNDOD,AUPNDOB,AUPNSEX
+5 KILL BMCSORT,BMCSRT,BMCSORX,BMCFILE,BMCFIEL,BMCPRNT,BMCX,BMCTYPE,BMCFOUN,D0,J,K,L,BMCPRNM,BMCTEST,BMCSEAT,BMCLHDR,BMCFRST,BMCTST
+6 QUIT
HEAD ;ENTRY POINT
+1 IF 'BMCPG
GOTO HEAD1
+2 IF $EXTRACT(IOST)="C"
IF IO=IO(0)
WRITE !
SET DIR(0)="EO"
DO ^DIR
KILL DIR
IF Y=0!(Y="^")!($DATA(DTOUT))
SET BMCQUIT=""
QUIT
HEAD1 ;EP
+1 IF $DATA(IOF)
WRITE @IOF
SET BMCPG=BMCPG+1
+2 IF $GET(BMCTITL)=""
SET BMCTEXT="PCC "_$SELECT(BMCPTVS="R":"REFERRAL",1:"PATIENT")_" LISTING"
SET BMCLENG=$LENGTH(BMCTEXT)
WRITE !?((BMCTCW-BMCLENG)/2),BMCTEXT,?(BMCTCW-8),"Page ",BMCPG
+3 IF $GET(BMCTITL)]""
SET BMCLENG=$LENGTH(BMCTITL)
WRITE !?((BMCTCW-BMCLENG)/2),BMCTITL,?(BMCTCW-8),"Page ",BMCPG
+4 ;I BMCTYPE="D" S BMCLENG=46 S:BMCTCW<BMCLENG BMCLENG=BMCTCW W !?((BMCTCW-BMCLENG)/2),"Referral Dates: ",BMCBDD," and ",BMCEDD,!
+5 ;I BMCTYPE="S" S BMCLENG=16+$L($P(^DIBT(BMCSEAT,0),U)) S:BMCTCW<BMCLENG BMCLENG=BMCTCW W !?((BMCTCW-BMCLENG)/2),"Search Template: ",$P(^DIBT(BMCSEAT,0),U),!
+6 IF $GET(BMCCTYP)="N"
SET BMCLENG=$LENGTH(BMCSORV)+27+$LENGTH(^BMCTSORT(BMCNSRT,0),U)
WRITE !?((80-BMCLENG)/2),"BASIC STATISTICS FOR: ",$PIECE(^BMCTSORT(BMCNSRT,0),U)
IF BMCSORT=6
WRITE !
IF BMCSORT'=6
WRITE " BY ",BMCSORV,!
+7 IF $GET(BMCCTYP)="S"
SET BMCLENG=$LENGTH(BMCSORV)+23
WRITE !?((BMCTCW-BMCLENG)/2),$SELECT(BMCPTVS="R":"REFERRAL",1:"PATIENT")," SUB-TOTALS BY: ",BMCSORV,!
+8 IF $GET(BMCSPAG)
SET BMCLENG=$LENGTH(BMCSORV)+$LENGTH(BMCSRTR)+2
IF BMCTCW<BMCLENG
SET BMCLENG=BMCTCW
WRITE !?((BMCTCW-BMCLENG)/2),BMCSORV,": ",BMCSRTR,!
+9 IF BMCHEAD]""
WRITE !,BMCHEAD,!
+10 IF $GET(BMCCTYP)="R"
WRITE !
+11 WRITE BMCDASH,!
+12 IF $GET(BMCCTYP)="S"
WRITE !,BMCSORV,":"
+13 QUIT
N ;EP
+1 DO HEAD
+2 IF '$DATA(^XTMP("BMCRL",BMCJOB,BMCBTH,"STATS"))
WRITE !!,"No records selected."
QUIT
+3 SET BMCREF=""
FOR
SET BMCREF=$ORDER(^XTMP("BMCRL",BMCJOB,BMCBTH,"STATS",BMCREF))
IF BMCREF=""!($DATA(BMCQUIT))
QUIT
SET BMCR=^XTMP("BMCRL",BMCJOB,BMCBTH,"STATS",BMCREF)
Begin DoDot:1
+4 IF $Y>(IOSL-10)
DO HEAD
IF $DATA(BMCQUIT)
QUIT
+5 WRITE !!?5,BMCREF
+6 WRITE !!?10,"Total referrals selected",?45,$JUSTIFY($PIECE(BMCR,U),12)
+7 WRITE !?10,"Total referrals w/",$PIECE(^BMCTSORT(BMCNSRT,0),U),?45,$JUSTIFY($PIECE(BMCR,U,6),12)
+8 SET X=$PIECE(BMCR,U,2)
IF $PIECE(^BMCTSORT(BMCNSRT,0),U,13)
SET X2="2$"
SET X3=14
DO COMMA^%DTC
+9 WRITE !?10,"Sum",?45,$JUSTIFY(X,14)
+10 SET X=$PIECE(BMCR,U,3)
IF $PIECE(^BMCTSORT(BMCNSRT,0),U,13)
SET X2="2$"
SET X3=14
DO COMMA^%DTC
+11 WRITE !?10,"Mean",?45,$JUSTIFY(X,14,2)
+12 SET X=$PIECE(BMCR,U,5)
IF $PIECE(^BMCTSORT(BMCNSRT,0),U,13)
SET X2="2$"
SET X3=14
DO COMMA^%DTC
+13 WRITE !?10,"Maximum Value",?45,$JUSTIFY(X,14)
+14 SET X=$PIECE(BMCR,U,4)
IF $PIECE(^BMCTSORT(BMCNSRT,0),U,13)
SET X2="2$"
SET X3=14
DO COMMA^%DTC
+15 WRITE !?10,"Minimum Value",?45,$JUSTIFY(X,14)
+16 QUIT
End DoDot:1
+17 IF $Y>(IOSL-10)
DO HEAD
+18 SET BMCR=^XTMP("BMCRL",BMCJOB,BMCBTH,"STATS")
+19 WRITE !!?5,"TOTALS"
+20 WRITE !!?10,"Total referrals selected",?45,$JUSTIFY($PIECE(BMCR,U),12)
+21 WRITE !?10,"Total referrals w/",$PIECE(^BMCTSORT(BMCNSRT,0),U),?45,$JUSTIFY($PIECE(BMCR,U,6),12)
+22 SET X=$PIECE(BMCR,U,2)
IF $PIECE(^BMCTSORT(BMCNSRT,0),U,13)
SET X2="2$"
SET X3=14
DO COMMA^%DTC
+23 WRITE !?10,"Sum",?45,$JUSTIFY(X,14)
+24 SET X=$PIECE(BMCR,U,3)
IF $PIECE(^BMCTSORT(BMCNSRT,0),U,13)
SET X2="2$"
SET X3=14
DO COMMA^%DTC
+25 WRITE !?10,"Mean",?45,$JUSTIFY(X,14,2)
+26 SET X=$PIECE(BMCR,U,5)
IF $PIECE(^BMCTSORT(BMCNSRT,0),U,13)
SET X2="2$"
SET X3=14
DO COMMA^%DTC
+27 WRITE !?10,"Maximum Value",?45,$JUSTIFY(X,14)
+28 SET X=$PIECE(BMCR,U,4)
IF $PIECE(^BMCTSORT(BMCNSRT,0),U,13)
SET X2="2$"
SET X3=14
DO COMMA^%DTC
+29 WRITE !?10,"Minimum Value",?45,$JUSTIFY(X,14)
+30 KILL BMCR,BMCREF
+31 QUIT
R ;EP record display
+1 DO HEAD
+2 DO EP^BMCRD(BMCREF)
+3 SET BMCX=0
FOR
SET BMCX=$ORDER(^TMP("BMCRDSP",$JOB,BMCX))
IF BMCX'=+BMCX!($DATA(BMCQUIT))
QUIT
Begin DoDot:1
+4 IF $Y>(IOSL-5)
DO HEAD
IF $DATA(BMCQUIT)
QUIT
+5 WRITE !,^TMP("BMCRDSP",$JOB,BMCX,0)
+6 QUIT
End DoDot:1
+7 QUIT
