- 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
