BMCRR23P ; IHS/OIT/FCJ - REPORT FOR CALL IN REFERRALS (2/2)
;;4.0;REFERRED CARE INFO SYSTEM;**12**;JAN 09, 2006;Build 101
;4.0*12;IHS/ITSC/FCJ NEW ROUTINE
;
START ;
S BMC80E="==============================================================================="
S BMC80D="-------------------------------------------------------------------------------"
S BMCSRTH=""
S BMCPG=0 D @("HEAD"_(2-($E(IOST,1,2)="C-"))) I '$D(^XTMP(BMCJOB,"BMCRR23",BMCBT)) W:BMCRTYP="S" !,BMC80D W !,"No referrals to report",! G DONE
SORT ;
S BMCSORT="",BMCQUIT=""
S (BMCRCTOT,BMCRRTOT,BMCRTOT,BMCCPO,BMCRPO,BMCRCDAY,BMCRRDAY,BMCTAVG)=0
F S BMCSORT=$O(^XTMP(BMCJOB,"BMCRR23",BMCBT,"DATA HITS",DUZ(2),BMCSORT)) Q:BMCSORT=""!BMCQUIT D PRINT
G:BMCQUIT DONE
I BMCRTYP="S" D SUM K ^XTMP(BMCJOB,"BMCRR23",BMCBTH,"FIL","R"),^XTMP(BMCJOB,"BMCRR23",BMCBTH,"FIL","C")
I BMCRTYP="D" D DETAIL S BMCRTYP="S" D HEAD1,SUM
D:$Y>(IOSL-6) HEAD D DONE
Q
DONE ;
D DONE^BMCRLP1
Q
PRINT ;
S BMCCFC="" D CHSFAC
S BMCREF=0
F S BMCREF=$O(^XTMP(BMCJOB,"BMCRR23",BMCBT,"DATA HITS",DUZ(2),BMCSORT,BMCREF)) Q:BMCREF'=+BMCREF!BMCQUIT D
.S BMCRREC=^BMCREF(BMCREF,0),DFN=$P(BMCRREC,U,3)
.S:BMCSORT="C" BMCRCTOT=BMCRCTOT+1
.S:BMCSORT="R" BMCRRTOT=BMCRRTOT+1
.S BMCRTOT=BMCRTOT+1 D PRINT1
Q
PRINT1 ;
S ^XTMP(BMCJOB,"BMCRR23",BMCBTH,"FIL",BMCSORT,BMCRTOT,0)=$P($G(^BMCREF(BMCREF,0)),U,2)_$P($G(^BMCREF(BMCREF,1)),U) ;Ref number
S Y=$P($G(^BMCREF(BMCREF,1)),U,3) I Y?1N.N D DT^BMCRUTL ;call-in date
S ^XTMP(BMCJOB,"BMCRR23",BMCBTH,"FIL",BMCSORT,BMCRTOT,0)=^XTMP(BMCJOB,"BMCRR23",BMCBTH,"FIL",BMCSORT,BMCRTOT,0)_"^"_Y
S Y=$P($G(^BMCREF(BMCREF,0)),U) I Y?1N.N D DT^BMCRUTL ;Ref initiated
S ^XTMP(BMCJOB,"BMCRR23",BMCBTH,"FIL",BMCSORT,BMCRTOT,0)=^XTMP(BMCJOB,"BMCRR23",BMCBTH,"FIL",BMCSORT,BMCRTOT,0)_"^"_Y
S Y=$P($G(^BMCREF(BMCREF,11)),U,13) I Y?1N.N D DT^BMCRUTL ;CHS APPROVAL DATE
S ^XTMP(BMCJOB,"BMCRR23",BMCBTH,"FIL",BMCSORT,BMCRTOT,0)=^XTMP(BMCJOB,"BMCRR23",BMCBTH,"FIL",BMCSORT,BMCRTOT,0)_"^"_Y
;MAYBE MORE THEN ONE PO, but only using the first PO, as it should be the primary visit.
S BMCPOC=0,L=0
S L=$O(^BMCREF(BMCREF,41,L)) Q:L'?1N.N D
.S BMCCHS=$P(^BMCREF(BMCREF,41,L,0),U)
.Q:$P($G(^ACHSF(DUZ(2),"D",BMCCHS,"PA")),U,4)'="F"
.Q:$P($G(^ACHSF(DUZ(2),"D",BMCCHS,"PA")),U,5)>0
.;PO ISSUED-BMCPOIS;PO PAID-BMCPOPD;PO NUMBER-BMCPO;DAYS TO PAY
.S BMCCHS0=^ACHSF(DUZ(2),"D",BMCCHS,0)
.S Y=$P(BMCCHS0,U,2) D DT^BMCRUTL ;PO ISSUED
.I BMCPOC>0 S ^XTMP(BMCJOB,"BMCRR23",BMCBTH,"FIL",BMCSORT,BMCRTOT,BMCPOC)="^^^"
.S ^XTMP(BMCJOB,"BMCRR23",BMCBTH,"FIL",BMCSORT,BMCRTOT,BMCPOC)=^XTMP(BMCJOB,"BMCRR23",BMCBTH,"FIL",BMCSORT,BMCRTOT,BMCPOC)_"^"_Y
.S ^XTMP(BMCJOB,"BMCRR23",BMCBTH,"FIL",BMCSORT,BMCRTOT,BMCPOC)=^XTMP(BMCJOB,"BMCRR23",BMCBTH,"FIL",BMCSORT,BMCRTOT,BMCPOC)_"^"_$E($P(BMCCHS0,U,27),3,4)_"-"_BMCCFC_"-"_$P(BMCCHS0,U) ;PO NUMBER
.S (X1,Y)=$P(^ACHSF(DUZ(2),"D",BMCCHS,"PA"),U,3) D DT^BMCRUTL ;DATE PAID
.S ^XTMP(BMCJOB,"BMCRR23",BMCBTH,"FIL",BMCSORT,BMCRTOT,BMCPOC)=^XTMP(BMCJOB,"BMCRR23",BMCBTH,"FIL",BMCSORT,BMCRTOT,BMCPOC)_"^"_Y
.;S X2=$S(BMCSORT="C":$P($G(^BMCREF(BMCREF,11)),U,13),1:$P(BMCCHS0,U,2)) D ^%DTC ;NO LONGER USING DATE APPROVED
.S X2=$P(BMCCHS0,U,2) D ^%DTC
.S ^XTMP(BMCJOB,"BMCRR23",BMCBTH,"FIL",BMCSORT,BMCRTOT,BMCPOC)=^XTMP(BMCJOB,"BMCRR23",BMCBTH,"FIL",BMCSORT,BMCRTOT,BMCPOC)_"^"_X
.S:BMCSORT="C" BMCRCDAY=BMCRCDAY+X S:BMCSORT="R" BMCRRDAY=BMCRRDAY+X
.S BMCPOC=BMCPOC+1 S:BMCSORT="C" BMCCPO=BMCCPO+1 S:BMCSORT="R" BMCRPO=BMCRPO+1
I (BMCCPO+BMCRPO)>0 S BMCTAVG=(BMCRCDAY+BMCRRDAY)/(BMCCPO+BMCRPO)
Q
DETAIL ;
S BMCTST=""
F BMCSORT="C","R" D:$D(^XTMP(BMCJOB,"BMCRR23",BMCBTH,"FIL",BMCSORT)) Q:BMCQUIT
.S BMCSRTH=$S(BMCSORT="C":"CHS CALL-IN REFERRAL",1:"CHS NON-CALL-IN REFERRAL")
.W:BMCTST'=BMCSORT !,BMCSRTH S BMCTST=BMCSORT
.S BMCR="" F S BMCR=$O(^XTMP(BMCJOB,"BMCRR23",BMCBTH,"FIL",BMCSORT,BMCR)) Q:BMCR'?1N.N D Q:BMCQUIT
..S BMCREC=^XTMP(BMCJOB,"BMCRR23",BMCBTH,"FIL",BMCSORT,BMCR,0)
..W !,$P(BMCREC,U),?16,$E($P(BMCREC,U,2),1,6)_$E($P(BMCREC,U,2),9,10),?25,$E($P(BMCREC,U,3),1,6)_$E($P(BMCREC,U,3),9,10),?34,$E($P(BMCREC,U,4),1,6)_$E($P(BMCREC,U,4),9,10)
..W ?43,$E($P(BMCREC,U,5),1,6)_$E($P(BMCREC,U,5),9,10),?52,$P(BMCREC,U,6),?65,$E($P(BMCREC,U,7),1,6)_$E($P(BMCREC,U,7),9,10),?74,$P(BMCREC,U,8)
..I $Y>(IOSL-5) D HEAD Q:BMCQUIT
..S BMCPOC=0 F S BMCPOC=$O(^XTMP(BMCJOB,"BMCRR23",BMCBTH,"FIL",BMCSORT,BMCR,BMCPOC)) Q:BMCPOC'?1N.N D Q:BMCQUIT
...S BMCREC=^XTMP(BMCJOB,"BMCRR23",BMCBTH,"FIL",BMCSORT,BMCR,BMCPOC)
...W !?43,$E($P(BMCREC,U,5),1,6)_$E($P(BMCREC,U,5),9,10),?52,$P(BMCREC,U,6),?65,$E($P(BMCREC,U,7),1,6)_$E($P(BMCREC,U,7),9,10),?74,$P(BMCREC,U,8)
...I $Y>(IOSL-5) D HEAD Q:BMCQUIT
.I $E(IOST)="C",IO=IO(0),'BMCQUIT W ! S DIR(0)="EO" D ^DIR K DIR W ! I Y=0!(Y="^")!($D(DTOUT)) S BMCQUIT=1
Q
CHSFAC ;
S BMCCFC=$P($G(^AUTTAREA($P($G(^AUTTLOC(DUZ(2),0)),U,4),0)),U,3)_$E($P($G(^AUTTLOC(DUZ(2),0)),U,17),2,3)
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=1 Q
HEAD1 ;
W:$D(IOF) @IOF
HEAD2 ;
S BMCPG=BMCPG+1
W !?12,"*********** 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 !?14,"CHS TYPE REFERRAL REPORT SORTED BY CALL-IN REFERRALS"
S Y=BMCBD D DD^%DT W !?17,"BEG DATE: "_Y
S Y=BMCED D DD^%DT W ?40,"END DATE: "_Y
I BMCRTYP="S" W !,BMC80D Q
HEAD3 ;
W !!,?3,"REFERRAL",?16,"CALL-IN",?25,"REFERRAL",?36,"CHS",?46,"PO",?74,"DAYS"
W !,?4,"NUMBER",?18,"DATE",?24,"INITIATED",?34,"APPROVAL",?44,"ISSUED",?53,"PO NUMBER",?65,"PO PAID",?73,"TO PAY"
W !,BMC80D
W !,BMCSRTH
Q
SUM ;
G:BMCRPT="C" SUMC
G:BMCRPT="N" SUMN
W !,"TOTAL CHS Referrals: ",BMCRTOT
W !,"TOTAL PO'S: ",BMCCPO+BMCRPO
W !,"TOTAL Days to Pay: ",BMCRCDAY+BMCRRDAY
W !,"Average Days to Pay: ",$FN(BMCTAVG,"",2) ;total days/total PO's
SUMC ;
W !!,"CHS Call-In Referrals from PO issue date to paid date"
W !,"TOTAL CHS Call-In Referrals: ",BMCRCTOT
W !,"TOTAL CHS Call-In Referral Days: ",BMCRCDAY
W !,"TOTAL CHS Call-In Referral Average Days: " W $S(BMCCPO>0:$FN((BMCRCDAY/BMCCPO),"",2),1:0)
Q:BMCRPT="C"
SUMN ;
W !!,"CHS Non-Call-In Referrals from PO issue date to paid date"
W !,"TOTAL CHS Non-Call-In Referrals: ",BMCRRTOT
W !,"TOTAL CHS Non-Call-In Referral Days: ",BMCRRDAY
W !,"TOTAL CHS Non-Call-In Referral Average Days: " W $S(BMCRPO>0:$FN((BMCRRDAY/BMCRPO),"",2),1:0)
Q
FILHDR ;
I BMCFIL="Y" D
.S ^XTMP(BMCJOB,"BMCRR23",BMCBTH,"FIL",1,"HDR1")="********** CONFIDENTIAL PATIENT INFORMATION **********"
.S ^XTMP(BMCJOB,"BMCRR23",BMCBTH,"FIL",1,"HDR2")=$P(^DIC(4,DUZ(2),0),U)
.S ^XTMP(BMCJOB,"BMCRR23",BMCBTH,"FIL",1,"HDR3")="CHS TYPE REFERRAL REPORT SORTED BY CALL-IN REFERRALS"
.S Y=BMCBD D DD^%DT S ^XTMP(BMCJOB,"BMCRR23",BMCBTH,"FIL",1,"HDR4")="BEG DATE: "_Y
.S Y=BMCED D DD^%DT S ^XTMP(BMCJOB,"BMCRR23",BMCBTH,"FIL",1,"HDR4")=^XTMP(BMCJOB,"BMCRR23",BMCBTH,"FIL",1,"HDR4")_" END DATE: "_Y
.I $D(^XTMP(BMCJOB,"BMCRR23",BMCBTH,"FIL","R")) S ^XTMP(BMCJOB,"BMCRR23",BMCBTH,"FIL","R",0)="CHS NON-CALL-IN REFERRAL"
.I $D(^XTMP(BMCJOB,"BMCRR23",BMCBTH,"FIL","C")) S ^XTMP(BMCJOB,"BMCRR23",BMCBTH,"FIL","C",0)="CHS CALL-IN REFERRAL"
.I ($D(^XTMP(BMCJOB,"BMCRR23",BMCBTH,"FIL","R")))!($D(^XTMP(BMCJOB,"BMCRR23",BMCBTH,"FIL","C"))) D
..S ^XTMP(BMCJOB,"BMCRR23",BMCBTH,"FIL",1,"HDR5")="REFERRAL NUMBER^CALL-IN DATE^REFERRAL INITIATED^CHS APPROVAL^PO ISSUED^PO NUMBER^PO PAID^DAYS TO PAY"
Q
FILSUM ;
G:BMCRPT="C" FILSUMC
G:BMCRPT="N" FILSUMN
S ^XTMP(BMCJOB,"BMCRR23",BMCBTH,"FIL","S",1)="TOTAL CHS Referrals: "_BMCRTOT
S ^XTMP(BMCJOB,"BMCRR23",BMCBTH,"FIL","S",2)="TOTAL PO'S: "_(BMCCPO+BMCRPO)
S ^XTMP(BMCJOB,"BMCRR23",BMCBTH,"FIL","S",3)="TOTAL Days to Pay: "_(BMCRCDAY+BMCRRDAY)
S ^XTMP(BMCJOB,"BMCRR23",BMCBTH,"FIL","S",4)="Average Days to Pay: "_$FN(BMCTAVG,"",2) ;total days/total PO's
FILSUMC ;
S ^XTMP(BMCJOB,"BMCRR23",BMCBTH,"FIL","S",5)="CHS Call-In Referrals from PO issue date to paid date"
S ^XTMP(BMCJOB,"BMCRR23",BMCBTH,"FIL","S",6)="TOTAL CHS Call-In Referrals: "_BMCRCTOT
S ^XTMP(BMCJOB,"BMCRR23",BMCBTH,"FIL","S",7)="TOTAL CHS Call-In Referral Days: "_BMCRCDAY
S ^XTMP(BMCJOB,"BMCRR23",BMCBTH,"FIL","S",8)="TOTAL CHS Call-In Referral Average Days: "_$S(BMCCPO>0:$FN((BMCRCDAY/BMCCPO),"",2),1:0)
Q:BMCRPT="C"
FILSUMN ;
S ^XTMP(BMCJOB,"BMCRR23",BMCBTH,"FIL","S",9)="CHS Non-Call-In Referrals from PO issue date to paid date"
S ^XTMP(BMCJOB,"BMCRR23",BMCBTH,"FIL","S",10)="TOTAL CHS Non-Call-In Referrals: "_BMCRRTOT
S ^XTMP(BMCJOB,"BMCRR23",BMCBTH,"FIL","S",11)="TOTAL CHS Non-Call-In Referral Days: "_BMCRRDAY
S ^XTMP(BMCJOB,"BMCRR23",BMCBTH,"FIL","S",12)="TOTAL CHS Non-Call-In Referral Average Days: "_$S(BMCRPO>0:$FN((BMCRRDAY/BMCRPO),"",2),1:0)
Q
FILSAV ;SAVE FILE
;
K ^XTMP(BMCJOB,"BMCRR23",BMCBTH,"DATA HITS")
N XBFN,XBE,XBJ,XBUF,XBQ,XBMED,XBFLT,XBS1,XBIO,XBF,XBGL
S X=$E(DT,4,7)_$E(DT,2,3)
D NOW^%DTC S X=(%I(3)+1700)_$E(%,4,7)_"_"_$P(%,".",2)
S:$L(X)'=15 X=X_0
S X1=$P(^AUTTLOC(DUZ(2),0),U,10),XBE=$J
S XBFN="REFERRAL-REPORT-"_X1_"."_X
S XBMED="F",XBFLT=1
S XBQ="N"
S XBUF=$P(^BMCPARM(DUZ(2),4100),U,13)
I XBUF="" S XBUF=$P(^AUTTSITE(1,1),U,2)
S XBS1="BMC RCIS REPORTS"
S XBIO=51,XBF=$J,XBGL="^XTMP(" D ^ZIBGSVEM
;S XBGL="TMP("_$J_",""ACHSVUR2"","D ^XBGSAVE
Q
BMCRR23P ; IHS/OIT/FCJ - REPORT FOR CALL IN REFERRALS (2/2)
+1 ;;4.0;REFERRED CARE INFO SYSTEM;**12**;JAN 09, 2006;Build 101
+2 ;4.0*12;IHS/ITSC/FCJ NEW ROUTINE
+3 ;
START ;
+1 SET BMC80E="==============================================================================="
+2 SET BMC80D="-------------------------------------------------------------------------------"
+3 SET BMCSRTH=""
+4 SET BMCPG=0
DO @("HEAD"_(2-($EXTRACT(IOST,1,2)="C-")))
IF '$DATA(^XTMP(BMCJOB,"BMCRR23",BMCBT))
IF BMCRTYP="S"
WRITE !,BMC80D
WRITE !,"No referrals to report",!
GOTO DONE
SORT ;
+1 SET BMCSORT=""
SET BMCQUIT=""
+2 SET (BMCRCTOT,BMCRRTOT,BMCRTOT,BMCCPO,BMCRPO,BMCRCDAY,BMCRRDAY,BMCTAVG)=0
+3 FOR
SET BMCSORT=$ORDER(^XTMP(BMCJOB,"BMCRR23",BMCBT,"DATA HITS",DUZ(2),BMCSORT))
IF BMCSORT=""!BMCQUIT
QUIT
DO PRINT
+4 IF BMCQUIT
GOTO DONE
+5 IF BMCRTYP="S"
DO SUM
KILL ^XTMP(BMCJOB,"BMCRR23",BMCBTH,"FIL","R"),^XTMP(BMCJOB,"BMCRR23",BMCBTH,"FIL","C")
+6 IF BMCRTYP="D"
DO DETAIL
SET BMCRTYP="S"
DO HEAD1
DO SUM
+7 IF $Y>(IOSL-6)
DO HEAD
DO DONE
+8 QUIT
DONE ;
+1 DO DONE^BMCRLP1
+2 QUIT
PRINT ;
+1 SET BMCCFC=""
DO CHSFAC
+2 SET BMCREF=0
+3 FOR
SET BMCREF=$ORDER(^XTMP(BMCJOB,"BMCRR23",BMCBT,"DATA HITS",DUZ(2),BMCSORT,BMCREF))
IF BMCREF'=+BMCREF!BMCQUIT
QUIT
Begin DoDot:1
+4 SET BMCRREC=^BMCREF(BMCREF,0)
SET DFN=$PIECE(BMCRREC,U,3)
+5 IF BMCSORT="C"
SET BMCRCTOT=BMCRCTOT+1
+6 IF BMCSORT="R"
SET BMCRRTOT=BMCRRTOT+1
+7 SET BMCRTOT=BMCRTOT+1
DO PRINT1
End DoDot:1
+8 QUIT
PRINT1 ;
+1 ;Ref number
SET ^XTMP(BMCJOB,"BMCRR23",BMCBTH,"FIL",BMCSORT,BMCRTOT,0)=$PIECE($GET(^BMCREF(BMCREF,0)),U,2)_$PIECE($GET(^BMCREF(BMCREF,1)),U)
+2 ;call-in date
SET Y=$PIECE($GET(^BMCREF(BMCREF,1)),U,3)
IF Y?1N.N
DO DT^BMCRUTL
+3 SET ^XTMP(BMCJOB,"BMCRR23",BMCBTH,"FIL",BMCSORT,BMCRTOT,0)=^XTMP(BMCJOB,"BMCRR23",BMCBTH,"FIL",BMCSORT,BMCRTOT,0)_"^"_Y
+4 ;Ref initiated
SET Y=$PIECE($GET(^BMCREF(BMCREF,0)),U)
IF Y?1N.N
DO DT^BMCRUTL
+5 SET ^XTMP(BMCJOB,"BMCRR23",BMCBTH,"FIL",BMCSORT,BMCRTOT,0)=^XTMP(BMCJOB,"BMCRR23",BMCBTH,"FIL",BMCSORT,BMCRTOT,0)_"^"_Y
+6 ;CHS APPROVAL DATE
SET Y=$PIECE($GET(^BMCREF(BMCREF,11)),U,13)
IF Y?1N.N
DO DT^BMCRUTL
+7 SET ^XTMP(BMCJOB,"BMCRR23",BMCBTH,"FIL",BMCSORT,BMCRTOT,0)=^XTMP(BMCJOB,"BMCRR23",BMCBTH,"FIL",BMCSORT,BMCRTOT,0)_"^"_Y
+8 ;MAYBE MORE THEN ONE PO, but only using the first PO, as it should be the primary visit.
+9 SET BMCPOC=0
SET L=0
+10 SET L=$ORDER(^BMCREF(BMCREF,41,L))
IF L'?1N.N
QUIT
Begin DoDot:1
+11 SET BMCCHS=$PIECE(^BMCREF(BMCREF,41,L,0),U)
+12 IF $PIECE($GET(^ACHSF(DUZ(2),"D",BMCCHS,"PA")),U,4)'="F"
QUIT
+13 IF $PIECE($GET(^ACHSF(DUZ(2),"D",BMCCHS,"PA")),U,5)>0
QUIT
+14 ;PO ISSUED-BMCPOIS;PO PAID-BMCPOPD;PO NUMBER-BMCPO;DAYS TO PAY
+15 SET BMCCHS0=^ACHSF(DUZ(2),"D",BMCCHS,0)
+16 ;PO ISSUED
SET Y=$PIECE(BMCCHS0,U,2)
DO DT^BMCRUTL
+17 IF BMCPOC>0
SET ^XTMP(BMCJOB,"BMCRR23",BMCBTH,"FIL",BMCSORT,BMCRTOT,BMCPOC)="^^^"
+18 SET ^XTMP(BMCJOB,"BMCRR23",BMCBTH,"FIL",BMCSORT,BMCRTOT,BMCPOC)=^XTMP(BMCJOB,"BMCRR23",BMCBTH,"FIL",BMCSORT,BMCRTOT,BMCPOC)_"^"_Y
+19 ;PO NUMBER
SET ^XTMP(BMCJOB,"BMCRR23",BMCBTH,"FIL",BMCSORT,BMCRTOT,BMCPOC)=^XTMP(BMCJOB,"BMCRR23",BMCBTH,"FIL",BMCSORT,BMCRTOT,BMCPOC)_"^"_$EXTRACT($PIECE(BMCCHS0,U,27),3,4)_"-"_BMCCFC_"-"_$PIECE(BMCCHS0,U)
+20 ;DATE PAID
SET (X1,Y)=$PIECE(^ACHSF(DUZ(2),"D",BMCCHS,"PA"),U,3)
DO DT^BMCRUTL
+21 SET ^XTMP(BMCJOB,"BMCRR23",BMCBTH,"FIL",BMCSORT,BMCRTOT,BMCPOC)=^XTMP(BMCJOB,"BMCRR23",BMCBTH,"FIL",BMCSORT,BMCRTOT,BMCPOC)_"^"_Y
+22 ;S X2=$S(BMCSORT="C":$P($G(^BMCREF(BMCREF,11)),U,13),1:$P(BMCCHS0,U,2)) D ^%DTC ;NO LONGER USING DATE APPROVED
+23 SET X2=$PIECE(BMCCHS0,U,2)
DO ^%DTC
+24 SET ^XTMP(BMCJOB,"BMCRR23",BMCBTH,"FIL",BMCSORT,BMCRTOT,BMCPOC)=^XTMP(BMCJOB,"BMCRR23",BMCBTH,"FIL",BMCSORT,BMCRTOT,BMCPOC)_"^"_X
+25 IF BMCSORT="C"
SET BMCRCDAY=BMCRCDAY+X
IF BMCSORT="R"
SET BMCRRDAY=BMCRRDAY+X
+26 SET BMCPOC=BMCPOC+1
IF BMCSORT="C"
SET BMCCPO=BMCCPO+1
IF BMCSORT="R"
SET BMCRPO=BMCRPO+1
End DoDot:1
+27 IF (BMCCPO+BMCRPO)>0
SET BMCTAVG=(BMCRCDAY+BMCRRDAY)/(BMCCPO+BMCRPO)
+28 QUIT
DETAIL ;
+1 SET BMCTST=""
+2 FOR BMCSORT="C","R"
IF $DATA(^XTMP(BMCJOB,"BMCRR23",BMCBTH,"FIL",BMCSORT))
Begin DoDot:1
+3 SET BMCSRTH=$SELECT(BMCSORT="C":"CHS CALL-IN REFERRAL",1:"CHS NON-CALL-IN REFERRAL")
+4 IF BMCTST'=BMCSORT
WRITE !,BMCSRTH
SET BMCTST=BMCSORT
+5 SET BMCR=""
FOR
SET BMCR=$ORDER(^XTMP(BMCJOB,"BMCRR23",BMCBTH,"FIL",BMCSORT,BMCR))
IF BMCR'?1N.N
QUIT
Begin DoDot:2
+6 SET BMCREC=^XTMP(BMCJOB,"BMCRR23",BMCBTH,"FIL",BMCSORT,BMCR,0)
+7 WRITE !,$PIECE(BMCREC,U),?16,$EXTRACT($PIECE(BMCREC,U,2),1,6)_$EXTRACT($PIECE(BMCREC,U,2),9,10),?25,$EXTRACT($PIECE(BMCREC,U,3),1,6)_$EXTRACT($PIECE(BMCREC,U,3),9,10),?34,$EXTRACT($PIECE(BMCREC,U,4),1,6)_$EXTRACT($PIECE(BMCR
EC,U,4),9,10)
+8 WRITE ?43,$EXTRACT($PIECE(BMCREC,U,5),1,6)_$EXTRACT($PIECE(BMCREC,U,5),9,10),?52,$PIECE(BMCREC,U,6),?65,$EXTRACT($PIECE(BMCREC,U,7),1,6)_$EXTRACT($PIECE(BMCREC,U,7),9,10),?74,$PIECE(BMCREC,U,8)
+9 IF $Y>(IOSL-5)
DO HEAD
IF BMCQUIT
QUIT
+10 SET BMCPOC=0
FOR
SET BMCPOC=$ORDER(^XTMP(BMCJOB,"BMCRR23",BMCBTH,"FIL",BMCSORT,BMCR,BMCPOC))
IF BMCPOC'?1N.N
QUIT
Begin DoDot:3
+11 SET BMCREC=^XTMP(BMCJOB,"BMCRR23",BMCBTH,"FIL",BMCSORT,BMCR,BMCPOC)
+12 WRITE !?43,$EXTRACT($PIECE(BMCREC,U,5),1,6)_$EXTRACT($PIECE(BMCREC,U,5),9,10),?52,$PIECE(BMCREC,U,6),?65,$EXTRACT($PIECE(BMCREC,U,7),1,6)_$EXTRACT($PIECE(BMCREC,U,7),9,10),?74,$PIECE(BMCREC,U,8)
+13 IF $Y>(IOSL-5)
DO HEAD
IF BMCQUIT
QUIT
End DoDot:3
IF BMCQUIT
QUIT
End DoDot:2
IF BMCQUIT
QUIT
+14 IF $EXTRACT(IOST)="C"
IF IO=IO(0)
IF 'BMCQUIT
WRITE !
SET DIR(0)="EO"
DO ^DIR
KILL DIR
WRITE !
IF Y=0!(Y="^")!($DATA(DTOUT))
SET BMCQUIT=1
End DoDot:1
IF BMCQUIT
QUIT
+15 QUIT
CHSFAC ;
+1 SET BMCCFC=$PIECE($GET(^AUTTAREA($PIECE($GET(^AUTTLOC(DUZ(2),0)),U,4),0)),U,3)_$EXTRACT($PIECE($GET(^AUTTLOC(DUZ(2),0)),U,17),2,3)
+2 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=1
QUIT
HEAD1 ;
+1 IF $DATA(IOF)
WRITE @IOF
HEAD2 ;
+1 SET BMCPG=BMCPG+1
+2 WRITE !?12,"*********** 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 !?14,"CHS TYPE REFERRAL REPORT SORTED BY CALL-IN REFERRALS"
+5 SET Y=BMCBD
DO DD^%DT
WRITE !?17,"BEG DATE: "_Y
+6 SET Y=BMCED
DO DD^%DT
WRITE ?40,"END DATE: "_Y
+7 IF BMCRTYP="S"
WRITE !,BMC80D
QUIT
HEAD3 ;
+1 WRITE !!,?3,"REFERRAL",?16,"CALL-IN",?25,"REFERRAL",?36,"CHS",?46,"PO",?74,"DAYS"
+2 WRITE !,?4,"NUMBER",?18,"DATE",?24,"INITIATED",?34,"APPROVAL",?44,"ISSUED",?53,"PO NUMBER",?65,"PO PAID",?73,"TO PAY"
+3 WRITE !,BMC80D
+4 WRITE !,BMCSRTH
+5 QUIT
SUM ;
+1 IF BMCRPT="C"
GOTO SUMC
+2 IF BMCRPT="N"
GOTO SUMN
+3 WRITE !,"TOTAL CHS Referrals: ",BMCRTOT
+4 WRITE !,"TOTAL PO'S: ",BMCCPO+BMCRPO
+5 WRITE !,"TOTAL Days to Pay: ",BMCRCDAY+BMCRRDAY
+6 ;total days/total PO's
WRITE !,"Average Days to Pay: ",$FNUMBER(BMCTAVG,"",2)
SUMC ;
+1 WRITE !!,"CHS Call-In Referrals from PO issue date to paid date"
+2 WRITE !,"TOTAL CHS Call-In Referrals: ",BMCRCTOT
+3 WRITE !,"TOTAL CHS Call-In Referral Days: ",BMCRCDAY
+4 WRITE !,"TOTAL CHS Call-In Referral Average Days: "
WRITE $SELECT(BMCCPO>0:$FNUMBER((BMCRCDAY/BMCCPO),"",2),1:0)
+5 IF BMCRPT="C"
QUIT
SUMN ;
+1 WRITE !!,"CHS Non-Call-In Referrals from PO issue date to paid date"
+2 WRITE !,"TOTAL CHS Non-Call-In Referrals: ",BMCRRTOT
+3 WRITE !,"TOTAL CHS Non-Call-In Referral Days: ",BMCRRDAY
+4 WRITE !,"TOTAL CHS Non-Call-In Referral Average Days: "
WRITE $SELECT(BMCRPO>0:$FNUMBER((BMCRRDAY/BMCRPO),"",2),1:0)
+5 QUIT
FILHDR ;
+1 IF BMCFIL="Y"
Begin DoDot:1
+2 SET ^XTMP(BMCJOB,"BMCRR23",BMCBTH,"FIL",1,"HDR1")="********** CONFIDENTIAL PATIENT INFORMATION **********"
+3 SET ^XTMP(BMCJOB,"BMCRR23",BMCBTH,"FIL",1,"HDR2")=$PIECE(^DIC(4,DUZ(2),0),U)
+4 SET ^XTMP(BMCJOB,"BMCRR23",BMCBTH,"FIL",1,"HDR3")="CHS TYPE REFERRAL REPORT SORTED BY CALL-IN REFERRALS"
+5 SET Y=BMCBD
DO DD^%DT
SET ^XTMP(BMCJOB,"BMCRR23",BMCBTH,"FIL",1,"HDR4")="BEG DATE: "_Y
+6 SET Y=BMCED
DO DD^%DT
SET ^XTMP(BMCJOB,"BMCRR23",BMCBTH,"FIL",1,"HDR4")=^XTMP(BMCJOB,"BMCRR23",BMCBTH,"FIL",1,"HDR4")_" END DATE: "_Y
+7 IF $DATA(^XTMP(BMCJOB,"BMCRR23",BMCBTH,"FIL","R"))
SET ^XTMP(BMCJOB,"BMCRR23",BMCBTH,"FIL","R",0)="CHS NON-CALL-IN REFERRAL"
+8 IF $DATA(^XTMP(BMCJOB,"BMCRR23",BMCBTH,"FIL","C"))
SET ^XTMP(BMCJOB,"BMCRR23",BMCBTH,"FIL","C",0)="CHS CALL-IN REFERRAL"
+9 IF ($DATA(^XTMP(BMCJOB,"BMCRR23",BMCBTH,"FIL","R")))!($DATA(^XTMP(BMCJOB,"BMCRR23",BMCBTH,"FIL","C")))
Begin DoDot:2
+10 SET ^XTMP(BMCJOB,"BMCRR23",BMCBTH,"FIL",1,"HDR5")="REFERRAL NUMBER^CALL-IN DATE^REFERRAL INITIATED^CHS APPROVAL^PO ISSUED^PO NUMBER^PO PAID^DAYS TO PAY"
End DoDot:2
End DoDot:1
+11 QUIT
FILSUM ;
+1 IF BMCRPT="C"
GOTO FILSUMC
+2 IF BMCRPT="N"
GOTO FILSUMN
+3 SET ^XTMP(BMCJOB,"BMCRR23",BMCBTH,"FIL","S",1)="TOTAL CHS Referrals: "_BMCRTOT
+4 SET ^XTMP(BMCJOB,"BMCRR23",BMCBTH,"FIL","S",2)="TOTAL PO'S: "_(BMCCPO+BMCRPO)
+5 SET ^XTMP(BMCJOB,"BMCRR23",BMCBTH,"FIL","S",3)="TOTAL Days to Pay: "_(BMCRCDAY+BMCRRDAY)
+6 ;total days/total PO's
SET ^XTMP(BMCJOB,"BMCRR23",BMCBTH,"FIL","S",4)="Average Days to Pay: "_$FNUMBER(BMCTAVG,"",2)
FILSUMC ;
+1 SET ^XTMP(BMCJOB,"BMCRR23",BMCBTH,"FIL","S",5)="CHS Call-In Referrals from PO issue date to paid date"
+2 SET ^XTMP(BMCJOB,"BMCRR23",BMCBTH,"FIL","S",6)="TOTAL CHS Call-In Referrals: "_BMCRCTOT
+3 SET ^XTMP(BMCJOB,"BMCRR23",BMCBTH,"FIL","S",7)="TOTAL CHS Call-In Referral Days: "_BMCRCDAY
+4 SET ^XTMP(BMCJOB,"BMCRR23",BMCBTH,"FIL","S",8)="TOTAL CHS Call-In Referral Average Days: "_$SELECT(BMCCPO>0:$FNUMBER((BMCRCDAY/BMCCPO),"",2),1:0)
+5 IF BMCRPT="C"
QUIT
FILSUMN ;
+1 SET ^XTMP(BMCJOB,"BMCRR23",BMCBTH,"FIL","S",9)="CHS Non-Call-In Referrals from PO issue date to paid date"
+2 SET ^XTMP(BMCJOB,"BMCRR23",BMCBTH,"FIL","S",10)="TOTAL CHS Non-Call-In Referrals: "_BMCRRTOT
+3 SET ^XTMP(BMCJOB,"BMCRR23",BMCBTH,"FIL","S",11)="TOTAL CHS Non-Call-In Referral Days: "_BMCRRDAY
+4 SET ^XTMP(BMCJOB,"BMCRR23",BMCBTH,"FIL","S",12)="TOTAL CHS Non-Call-In Referral Average Days: "_$SELECT(BMCRPO>0:$FNUMBER((BMCRRDAY/BMCRPO),"",2),1:0)
+5 QUIT
FILSAV ;SAVE FILE
+1 ;
+2 KILL ^XTMP(BMCJOB,"BMCRR23",BMCBTH,"DATA HITS")
+3 NEW XBFN,XBE,XBJ,XBUF,XBQ,XBMED,XBFLT,XBS1,XBIO,XBF,XBGL
+4 SET X=$EXTRACT(DT,4,7)_$EXTRACT(DT,2,3)
+5 DO NOW^%DTC
SET X=(%I(3)+1700)_$EXTRACT(%,4,7)_"_"_$PIECE(%,".",2)
+6 IF $LENGTH(X)'=15
SET X=X_0
+7 SET X1=$PIECE(^AUTTLOC(DUZ(2),0),U,10)
SET XBE=$JOB
+8 SET XBFN="REFERRAL-REPORT-"_X1_"."_X
+9 SET XBMED="F"
SET XBFLT=1
+10 SET XBQ="N"
+11 SET XBUF=$PIECE(^BMCPARM(DUZ(2),4100),U,13)
+12 IF XBUF=""
SET XBUF=$PIECE(^AUTTSITE(1,1),U,2)
+13 SET XBS1="BMC RCIS REPORTS"
+14 SET XBIO=51
SET XBF=$JOB
SET XBGL="^XTMP("
DO ^ZIBGSVEM
+15 ;S XBGL="TMP("_$J_",""ACHSVUR2"","D ^XBGSAVE
+16 QUIT
