- BMCRR4P ; IHS/PHXAO/TMJ - PRNT BILL VSTS ; [ 09/27/2006 2:16 PM ]
- ;;4.0;REFERRED CARE INFO SYSTEM;**1**;JAN 09, 2006;Build 101
- ;4.0*1 3.7.06 IHS/OIT/FCJ MODIFIED TO PRT PROV IN ALPHA ORDER
- START ;
- S BMC80E="==============================================================================="
- S BMC80D="-------------------------------------------------------------------------------"
- S BMCPG=0 D @("HEAD"_(2-($E(IOST,1,2)="C-")))
- I '$D(^XTMP("BMCRR4",BMCJOB,BMCBT)) W !,"No data to report",! G DONE
- S BMCPN=0 K BMCQUIT
- ;4.0*1 3.7.06 IHS/OIT/FCJ REWROTE NXT SECTION TO PRT PROV IN ALPHA ORDR
- I BMCTYPE="P" S BMCSORT=0 D
- .F S BMCSORT=$O(^XTMP("BMCRR4",BMCJOB,BMCBT,"REFERRALS",BMCSORT)) Q:BMCSORT=""!($D(BMCQUIT)) S BMCPN=0 D
- ..F S BMCPN=$O(^XTMP("BMCRR4",BMCJOB,BMCBT,"REFERRALS",BMCSORT,BMCPN)) Q:BMCPN=""!($D(BMCQUIT)) S BMCX=^XTMP("BMCRR4",BMCJOB,BMCBT,"REFERRALS",BMCPN) D PROC
- E F S BMCPN=$O(^XTMP("BMCRR4",BMCJOB,BMCBT,"REFERRALS",BMCPN)) Q:BMCPN=""!($D(BMCQUIT)) S BMCX=^XTMP("BMCRR4",BMCJOB,BMCBT,"REFERRALS",BMCPN) D PROC
- ;4.0*1 3.7.06 IHS/OIT/FCJ END OF REWRITE
- DONE ;
- K ^XTMP("BMCRR4",BMCJOB,BMCBT)
- D DONE^BMCRLP2
- Q
- PROC ;
- I $Y>(IOSL-5) D HEAD Q:$D(BMCQUIT)
- S X=$S(BMCTYPE="P":$P(^VA(200,BMCPN,0),U),1:$P(^DIC(4,BMCPN,0),U))
- W !,$E(X,1,20),?25,$J($P(BMCX,U),5)
- W ?32,$J($P(BMCX,U,2),5)
- W ?37,$J($P(BMCX,U,3),5)
- W ?43,$J($P(BMCX,U,4),5)
- S X=$S($D(^XTMP("BMCRR4",BMCJOB,BMCBT,"PCC VISITS",BMCPN)):^(BMCPN),1:0)
- W ?50,$J(X,6)
- I X W ?64,$J(($P(BMCX,U)/X)*100,5,0)
- Q
- HEAD ;ENTRY POINT
- 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 ;
- W:$D(IOF) @IOF
- HEAD2 ;
- S BMCPG=BMCPG+1
- W !?13,"********** CONFIDENTIAL PATIENT INFORMATION **********"
- W !?(80-$L($P(^DIC(4,DUZ(2),0),U))/2),$P(^DIC(4,DUZ(2),0),U),?72,"Page ",BMCPG,!!
- W ?19,"REFERRAL PATTERNS BY REQUESTING ",$S(BMCTYPE="P":"PROVIDER",1:"FACILITY"),!
- S Y=DT D DD^%DT W ?(80-$L(Y)/2),Y
- S Y=BMCBD D DD^%DT W !,?28,"BEG DATE: "_Y
- S Y=BMCED D DD^%DT W !,?28,"END DATE: "_Y,!
- W !,$S(BMCTYPE="P":"PROVIDER",1:"FACILITY"),?23,"# REFS",?33,"IHS",?38,"OTHER",?44,"CHS",?50,"# PCC",?59,"TOTAL REF RATE"
- W !,?23,"INITIATED",?33,"REFS",?38,"REFS",?44,"REFS",?50,"VISITS",?59,"PER 100 PCC VISITS"
- W !,BMC80D
- Q
- BMCRR4P ; IHS/PHXAO/TMJ - PRNT BILL VSTS ; [ 09/27/2006 2:16 PM ]
- +1 ;;4.0;REFERRED CARE INFO SYSTEM;**1**;JAN 09, 2006;Build 101
- +2 ;4.0*1 3.7.06 IHS/OIT/FCJ MODIFIED TO PRT PROV IN ALPHA ORDER
- START ;
- +1 SET BMC80E="==============================================================================="
- +2 SET BMC80D="-------------------------------------------------------------------------------"
- +3 SET BMCPG=0
- DO @("HEAD"_(2-($EXTRACT(IOST,1,2)="C-")))
- +4 IF '$DATA(^XTMP("BMCRR4",BMCJOB,BMCBT))
- WRITE !,"No data to report",!
- GOTO DONE
- +5 SET BMCPN=0
- KILL BMCQUIT
- +6 ;4.0*1 3.7.06 IHS/OIT/FCJ REWROTE NXT SECTION TO PRT PROV IN ALPHA ORDR
- +7 IF BMCTYPE="P"
- SET BMCSORT=0
- Begin DoDot:1
- +8 FOR
- SET BMCSORT=$ORDER(^XTMP("BMCRR4",BMCJOB,BMCBT,"REFERRALS",BMCSORT))
- IF BMCSORT=""!($DATA(BMCQUIT))
- QUIT
- SET BMCPN=0
- Begin DoDot:2
- +9 FOR
- SET BMCPN=$ORDER(^XTMP("BMCRR4",BMCJOB,BMCBT,"REFERRALS",BMCSORT,BMCPN))
- IF BMCPN=""!($DATA(BMCQUIT))
- QUIT
- SET BMCX=^XTMP("BMCRR4",BMCJOB,BMCBT,"REFERRALS",BMCPN)
- DO PROC
- End DoDot:2
- End DoDot:1
- +10 IF '$TEST
- FOR
- SET BMCPN=$ORDER(^XTMP("BMCRR4",BMCJOB,BMCBT,"REFERRALS",BMCPN))
- IF BMCPN=""!($DATA(BMCQUIT))
- QUIT
- SET BMCX=^XTMP("BMCRR4",BMCJOB,BMCBT,"REFERRALS",BMCPN)
- DO PROC
- +11 ;4.0*1 3.7.06 IHS/OIT/FCJ END OF REWRITE
- DONE ;
- +1 KILL ^XTMP("BMCRR4",BMCJOB,BMCBT)
- +2 DO DONE^BMCRLP2
- +3 QUIT
- PROC ;
- +1 IF $Y>(IOSL-5)
- DO HEAD
- IF $DATA(BMCQUIT)
- QUIT
- +2 SET X=$SELECT(BMCTYPE="P":$PIECE(^VA(200,BMCPN,0),U),1:$PIECE(^DIC(4,BMCPN,0),U))
- +3 WRITE !,$EXTRACT(X,1,20),?25,$JUSTIFY($PIECE(BMCX,U),5)
- +4 WRITE ?32,$JUSTIFY($PIECE(BMCX,U,2),5)
- +5 WRITE ?37,$JUSTIFY($PIECE(BMCX,U,3),5)
- +6 WRITE ?43,$JUSTIFY($PIECE(BMCX,U,4),5)
- +7 SET X=$SELECT($DATA(^XTMP("BMCRR4",BMCJOB,BMCBT,"PCC VISITS",BMCPN)):^(BMCPN),1:0)
- +8 WRITE ?50,$JUSTIFY(X,6)
- +9 IF X
- WRITE ?64,$JUSTIFY(($PIECE(BMCX,U)/X)*100,5,0)
- +10 QUIT
- HEAD ;ENTRY POINT
- +1 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 ;
- +1 IF $DATA(IOF)
- WRITE @IOF
- HEAD2 ;
- +1 SET BMCPG=BMCPG+1
- +2 WRITE !?13,"********** CONFIDENTIAL PATIENT INFORMATION **********"
- +3 WRITE !?(80-$LENGTH($PIECE(^DIC(4,DUZ(2),0),U))/2),$PIECE(^DIC(4,DUZ(2),0),U),?72,"Page ",BMCPG,!!
- +4 WRITE ?19,"REFERRAL PATTERNS BY REQUESTING ",$SELECT(BMCTYPE="P":"PROVIDER",1:"FACILITY"),!
- +5 SET Y=DT
- DO DD^%DT
- WRITE ?(80-$LENGTH(Y)/2),Y
- +6 SET Y=BMCBD
- DO DD^%DT
- WRITE !,?28,"BEG DATE: "_Y
- +7 SET Y=BMCED
- DO DD^%DT
- WRITE !,?28,"END DATE: "_Y,!
- +8 WRITE !,$SELECT(BMCTYPE="P":"PROVIDER",1:"FACILITY"),?23,"# REFS",?33,"IHS",?38,"OTHER",?44,"CHS",?50,"# PCC",?59,"TOTAL REF RATE"
- +9 WRITE !,?23,"INITIATED",?33,"REFS",?38,"REFS",?44,"REFS",?50,"VISITS",?59,"PER 100 PCC VISITS"
- +10 WRITE !,BMC80D
- +11 QUIT
