- BMCRR3P ; IHS/PHXAO/TMJ - PRNT BILL VSTS ; [ 09/27/2006 2:14 PM ]
- ;;4.0;REFERRED CARE INFO SYSTEM;**1**;JAN 09, 2006;Build 101
- ;4.0*1 3.8.06 IHS/OIT/FCJ PRINT BEG AND END DT
- START ;
- S BMC80E="==============================================================================="
- S BMC80D="-------------------------------------------------------------------------------"
- S BMCPG=0 D @("HEAD"_(2-($E(IOST,1,2)="C-"))) I '$D(^XTMP("BMCRR3",BMCJOB,BMCBT)) W !,"No patientss to report",! G DONE
- S BMCPN=0 K BMCQUIT
- F S BMCPN=$O(^XTMP("BMCRR3",BMCJOB,BMCBT,"DATA HITS",BMCPN)) Q:BMCPN=""!($D(BMCQUIT)) D DFN
- DONE ;
- K ^XTMP("BMCRR3",BMCJOB,BMCBT)
- D DONE^BMCRLP2
- Q
- DFN ;
- S DFN="" F S DFN=$O(^XTMP("BMCRR3",BMCJOB,BMCBT,"DATA HITS",BMCPN,DFN)) Q:DFN=""!($D(BMCQUIT)) D PRINT
- Q
- PRINT ;print one referral
- Q:$P(^XTMP("BMCRR3",BMCJOB,BMCBTH,"DATA HITS",BMCPN,DFN),U,2)<BMCAMT
- I $Y>(IOSL-5) D HEAD Q:$D(BMCQUIT)
- W !,$E(BMCPN,1,25)
- S BMCHRN="????" I $D(^AUPNPAT(DFN,41,DUZ(2))) S BMCHRN=$P(^AUTTLOC(DUZ(2),0),U,7)_$P(^AUPNPAT(DFN,41,DUZ(2),0),U,2)
- W ?28,BMCHRN
- W ?40,$$FMTE^XLFDT($P(^DPT(DFN,0),U,3),"5D")
- W ?52,$P(^DPT(DFN,0),U,2)
- W ?56,$J($P(^XTMP("BMCRR3",BMCJOB,BMCBTH,"DATA HITS",BMCPN,DFN),U),5)
- S X=$P(^XTMP("BMCRR3",BMCJOB,BMCBTH,"DATA HITS",BMCPN,DFN),U,2),X2="2$" D COMMA^%DTC W ?64,X
- 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 !?21,"******** PRIMARY REFERRALS *******"
- W !?(80-$L($P(^DIC(4,DUZ(2),0),U))/2),$P(^DIC(4,DUZ(2),0),U),?72,"Page ",BMCPG,!
- W ?22,"HIGH COST USERS - "_$S(BMCCOST="I":"using IHS COST",1:"using TOTAL COST"),!
- ;4.0*1 3.8.06 IHS/OIT/FCJ ADDED NXT 2 LINES TO PRT BEG AND END DT
- S Y=BMCBD D DD^%DT W ?17,"BEG DATE: "_Y
- S Y=BMCED D DD^%DT W ?40,"END DATE: "_Y,!
- 0 W !,"PATIENT NAME",?28," HRN",?40,"DOB",?51,"SEX",?56,"# REFS",?64,"TOTAL COST"
- W !,BMC80D
- Q
- BMCRR3P ; IHS/PHXAO/TMJ - PRNT BILL VSTS ; [ 09/27/2006 2:14 PM ]
- +1 ;;4.0;REFERRED CARE INFO SYSTEM;**1**;JAN 09, 2006;Build 101
- +2 ;4.0*1 3.8.06 IHS/OIT/FCJ PRINT BEG AND END DT
- START ;
- +1 SET BMC80E="==============================================================================="
- +2 SET BMC80D="-------------------------------------------------------------------------------"
- +3 SET BMCPG=0
- DO @("HEAD"_(2-($EXTRACT(IOST,1,2)="C-")))
- IF '$DATA(^XTMP("BMCRR3",BMCJOB,BMCBT))
- WRITE !,"No patientss to report",!
- GOTO DONE
- +4 SET BMCPN=0
- KILL BMCQUIT
- +5 FOR
- SET BMCPN=$ORDER(^XTMP("BMCRR3",BMCJOB,BMCBT,"DATA HITS",BMCPN))
- IF BMCPN=""!($DATA(BMCQUIT))
- QUIT
- DO DFN
- DONE ;
- +1 KILL ^XTMP("BMCRR3",BMCJOB,BMCBT)
- +2 DO DONE^BMCRLP2
- +3 QUIT
- DFN ;
- +1 SET DFN=""
- FOR
- SET DFN=$ORDER(^XTMP("BMCRR3",BMCJOB,BMCBT,"DATA HITS",BMCPN,DFN))
- IF DFN=""!($DATA(BMCQUIT))
- QUIT
- DO PRINT
- +2 QUIT
- PRINT ;print one referral
- +1 IF $PIECE(^XTMP("BMCRR3",BMCJOB,BMCBTH,"DATA HITS",BMCPN,DFN),U,2)<BMCAMT
- QUIT
- +2 IF $Y>(IOSL-5)
- DO HEAD
- IF $DATA(BMCQUIT)
- QUIT
- +3 WRITE !,$EXTRACT(BMCPN,1,25)
- +4 SET BMCHRN="????"
- IF $DATA(^AUPNPAT(DFN,41,DUZ(2)))
- SET BMCHRN=$PIECE(^AUTTLOC(DUZ(2),0),U,7)_$PIECE(^AUPNPAT(DFN,41,DUZ(2),0),U,2)
- +5 WRITE ?28,BMCHRN
- +6 WRITE ?40,$$FMTE^XLFDT($PIECE(^DPT(DFN,0),U,3),"5D")
- +7 WRITE ?52,$PIECE(^DPT(DFN,0),U,2)
- +8 WRITE ?56,$JUSTIFY($PIECE(^XTMP("BMCRR3",BMCJOB,BMCBTH,"DATA HITS",BMCPN,DFN),U),5)
- +9 SET X=$PIECE(^XTMP("BMCRR3",BMCJOB,BMCBTH,"DATA HITS",BMCPN,DFN),U,2)
- SET X2="2$"
- DO COMMA^%DTC
- WRITE ?64,X
- +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 !?21,"******** PRIMARY REFERRALS *******"
- +4 WRITE !?(80-$LENGTH($PIECE(^DIC(4,DUZ(2),0),U))/2),$PIECE(^DIC(4,DUZ(2),0),U),?72,"Page ",BMCPG,!
- +5 WRITE ?22,"HIGH COST USERS - "_$SELECT(BMCCOST="I":"using IHS COST",1:"using TOTAL COST"),!
- +6 ;4.0*1 3.8.06 IHS/OIT/FCJ ADDED NXT 2 LINES TO PRT BEG AND END DT
- +7 SET Y=BMCBD
- DO DD^%DT
- WRITE ?17,"BEG DATE: "_Y
- +8 SET Y=BMCED
- DO DD^%DT
- WRITE ?40,"END DATE: "_Y,!
- 0 WRITE !,"PATIENT NAME",?28," HRN",?40,"DOB",?51,"SEX",?56,"# REFS",?64,"TOTAL COST"
- +1 WRITE !,BMC80D
- +2 QUIT
