BMCRR23 ; IHS/OIT/FCJ - REPORT FOR CALL IN REFERRALS (1/2)
;;4.0;REFERRED CARE INFO SYSTEM;**12**;JAN 09, 2006;Build 101
;4.0*12 NEW ROUTINE
;NEW REPORT FOR GAO REQUIREMENT TO TRACK CALL IN REFERRALS
;
START ;
D PCCTST S BMCJOB=$J
K ^XTMP(BMCJOB,"BMCRR23")
W:$D(IOF) @IOF
W !,?14,"************* CHS Paid Referral Report *************"
W !!,"Report will capture CHS Primary referrals. Report will sort by Call-in"
W !,"Referrals. The CHS PO's must be final paid without out any Third Party"
W !,"Payment. If the call-in notification date is not available the referral"
W !,"will be checked for a PCC Visit to identify Call-in referrals."
W !!,"If the PCC link was not on during anytime within reporting time"
W !,"frame, this report MAY NOT be accurate for identifying Call-in referrals."
I BMCPDT'="" D
.W !!,"Facility does not use the PCC link, the earliest beginning date for report"
.W !,"can be ",BMCPDT1,"."
W !,!
BD ;get beginning date and ending dates
K DIR("B")
I BMCPDT'="" D
.W ! S DIR(0)="D^"_BMCPDT_":DT:EP",DIR("A")="Enter beginning Referral Date" D ^DIR S:$D(DUOUT) DIRUT=1 K DIR S:$D(DUOUT) DIRUT=1
.I $D(DIRUT) G EXIT
.S BMCBD=Y
.D ED^BMCRUTL
E D BD^BMCRUTL
G:$D(DIRUT) EXIT
SELRPT ;REPORT TYPE CALL-IN, NON CALL-IN OR BOTH
K DIR,DIC
S DIR("A")="Report Type",DIR(0)="S^C:Call-in Referrals;N:Non Call-in Referrals;B:Both" S DIR("B")="Both"
W !
D ^DIR
G BD:$D(DUOUT),EXIT:$D(DTOUT),EXIT:$D(DIROUT)
S BMCRPT=Y
TYPE ; TYPE OF REPORT SUMARRY OR DETAILED
; Enter Summary or Detail
S DIR(0)="S^S:SUMMARY;D:DETAILED",DIR("A")="Report Type ",DIR("B")="SUMMARY"
S DIR("?")="Detail will display indiviual Referrals, Summary will display only the totals"
D ^DIR
G SELRPT:$D(DUOUT),EXIT:$D(DTOUT),EXIT:$D(DIROUT)
S BMCRTYP=Y
FILE ;CREATE A FILE
S %=$$DIR^XBDIR("Y","Create a file","N","","","^D HELP^ACHS(""H2"",""ACHSVUR2"")",2)
G TYPE:$D(DUOUT),EXIT:$D(DTOUT)
S BMCFIL=$S(%:"Y",1:"N")
ZIS ;call to XBDBQUE
K BMCOPT
W ! S DIR(0)="S^P:PRINT Output;B:BROWSE Output on Screen",DIR("A")="Do you wish to",DIR("B")="P" K DA D ^DIR K DIR
I $D(DIRUT) S BMCQUIT="" Q
S BMCOPT=Y
G:$G(BMCQUIT) FILE
I $G(BMCOPT)="B" D BROWSE,EXIT Q
S XBRP="^BMCRR23P",XBRC="STPROC^BMCRR23",XBRX="EXIT^BMCRR23",XBNS="BMC"
D ^XBDBQUE
Q
BROWSE ;
S XBRP="VIEWR^XBLM(""^BMCRR23P"")"
S XBRC="STPROC^BMCRR23",XBIOP=0 D ^XBDBQUE
Q
FIL2 ;CREATE THE FILE
D FILHDR^BMCRR23P
D FILSUM^BMCRR23P
D FILSAV^BMCRR23P
Q
EXIT ;
I $D(BMCFIL) D:BMCFIL="Y" FIL2
D KILL^AUPNPAT
K BMC80D,BMC80E,BMCBT,BMCBTH,BMCET,BMCOPT,BMCPG,BMCQUIT,BMCRCNT,BMCREF,BMCRREC,BMCSORT,BMCSTYPE
K BMCBD,BMCED,BMCBDD,BMCEDD,BMCSD,BMCRTYP,BMCFIL,BMCRTH,BMCCHS,BMCHIT,BMCJOB,BMCODAT,BMCPDT,BMCRPT
K BMCCFC,BMCCHS0,BMCCPO,BMCPOC,BMCR,BMCRCDAY,BMCRCTOT,BMCREC,BMCRPO,BMCRRDAY,BMCRRTOT,BMCRTOT,BMCSRTH,BMCTAVG
K DA,DFN,DIR,X,Y
K ^XTMP($J,"BMCRR23")
Q
PCCTST ;IF SITE DOES NOT USE PCC LINK THE EARLIEST DATE FOR REPORT WILL BE WHEN V4 P12 WAS INSTALLED
S BMCPDT="",BMCPDT=""
I $P(^BMCPARM(DUZ(2),0),U,3)<1 S BMCPDT=$P(^BMCPARM(DUZ(2),4100),U,12),Y=BMCPDT D DD^%DT S BMCPDT1=Y
Q
STPROC ;
S (BMCBT,BMCBTH)=$H,BMCRCNT=0
D PROCESS,END
Q
;
PROCESS ;
S BMCODAT=$O(^BMCREF("B",BMCSD)) I BMCODAT="" S BMCET=$H Q
S BMCODAT=BMCSD_".9999"
F S BMCODAT=$O(^BMCREF("B",BMCODAT)) Q:BMCODAT=""!((BMCODAT\1)>BMCED) D R1
Q
;
R1 ;
S BMCREF=""
F S BMCREF=$O(^BMCREF("B",BMCODAT,BMCREF)) Q:BMCREF'=+BMCREF S BMCRREC=^BMCREF(BMCREF,0) D PROCESS2
Q
;
END ;
S BMCET=$H
Q
PROCESS2 ;
S BMCRREC=^BMCREF(BMCREF,0),DFN=$P(BMCRREC,U,3),BMCSORT="R"
;TEST FOR CHS REFERRAL
Q:$P(BMCRREC,U,4)'="C"
;TEST FOR PRIMARY REFERRAL
Q:$P($G(^BMCREF(BMCREF,1)),U)'=""
;TEST FOR PO AND PAID
Q:($P($G(^BMCREF(BMCREF,11)),U,15)<1)&($P($G(^BMCREF(BMCREF,11)),U,16)<0)
;TEST FOR 0 THIRD PARTY PAY, FINAL PAY AND FIRST PO ENTERED
S L=0,BMCCHS="",BMCHIT=""
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,5)>0
.S:$P($G(^ACHSF(DUZ(2),"D",BMCCHS,"PA")),U,4)="F" BMCHIT=1
Q:BMCHIT<1
;NOTIFICATION or PCC VISIT - Will be considered a call in if PCC link is on
I BMCPDT,$P($G(^BMCREF(BMCREF,1)),U,4)'="" S BMCSORT="C" G SET ;PCC LINK AND CALL IN
I ($P($G(^BMCREF(BMCREF,1)),U,4)'="")!($P($G(^BMCREF(BMCREF,13)),U,9)="") S BMCSORT="C" ;CALLIN OR NO VISIT
SET ;
Q:((BMCSORT="C")&(BMCRPT="N"))
Q:((BMCSORT="R")&(BMCRPT="C"))
Q:$P(^BMCREF(BMCREF,0),U,5)'=DUZ(2)
S ^XTMP(BMCJOB,"BMCRR23",BMCBTH,"DATA HITS",DUZ(2),BMCSORT,BMCREF)="",BMCRCNT=BMCRCNT+1
Q
BMCRR23 ; IHS/OIT/FCJ - REPORT FOR CALL IN REFERRALS (1/2)
+1 ;;4.0;REFERRED CARE INFO SYSTEM;**12**;JAN 09, 2006;Build 101
+2 ;4.0*12 NEW ROUTINE
+3 ;NEW REPORT FOR GAO REQUIREMENT TO TRACK CALL IN REFERRALS
+4 ;
START ;
+1 DO PCCTST
SET BMCJOB=$JOB
+2 KILL ^XTMP(BMCJOB,"BMCRR23")
+3 IF $DATA(IOF)
WRITE @IOF
+4 WRITE !,?14,"************* CHS Paid Referral Report *************"
+5 WRITE !!,"Report will capture CHS Primary referrals. Report will sort by Call-in"
+6 WRITE !,"Referrals. The CHS PO's must be final paid without out any Third Party"
+7 WRITE !,"Payment. If the call-in notification date is not available the referral"
+8 WRITE !,"will be checked for a PCC Visit to identify Call-in referrals."
+9 WRITE !!,"If the PCC link was not on during anytime within reporting time"
+10 WRITE !,"frame, this report MAY NOT be accurate for identifying Call-in referrals."
+11 IF BMCPDT'=""
Begin DoDot:1
+12 WRITE !!,"Facility does not use the PCC link, the earliest beginning date for report"
+13 WRITE !,"can be ",BMCPDT1,"."
End DoDot:1
+14 WRITE !,!
BD ;get beginning date and ending dates
+1 KILL DIR("B")
+2 IF BMCPDT'=""
Begin DoDot:1
+3 WRITE !
SET DIR(0)="D^"_BMCPDT_":DT:EP"
SET DIR("A")="Enter beginning Referral Date"
DO ^DIR
IF $DATA(DUOUT)
SET DIRUT=1
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+4 IF $DATA(DIRUT)
GOTO EXIT
+5 SET BMCBD=Y
+6 DO ED^BMCRUTL
End DoDot:1
+7 IF '$TEST
DO BD^BMCRUTL
+8 IF $DATA(DIRUT)
GOTO EXIT
SELRPT ;REPORT TYPE CALL-IN, NON CALL-IN OR BOTH
+1 KILL DIR,DIC
+2 SET DIR("A")="Report Type"
SET DIR(0)="S^C:Call-in Referrals;N:Non Call-in Referrals;B:Both"
SET DIR("B")="Both"
+3 WRITE !
+4 DO ^DIR
+5 IF $DATA(DUOUT)
GOTO BD
IF $DATA(DTOUT)
GOTO EXIT
IF $DATA(DIROUT)
GOTO EXIT
+6 SET BMCRPT=Y
TYPE ; TYPE OF REPORT SUMARRY OR DETAILED
+1 ; Enter Summary or Detail
+2 SET DIR(0)="S^S:SUMMARY;D:DETAILED"
SET DIR("A")="Report Type "
SET DIR("B")="SUMMARY"
+3 SET DIR("?")="Detail will display indiviual Referrals, Summary will display only the totals"
+4 DO ^DIR
+5 IF $DATA(DUOUT)
GOTO SELRPT
IF $DATA(DTOUT)
GOTO EXIT
IF $DATA(DIROUT)
GOTO EXIT
+6 SET BMCRTYP=Y
FILE ;CREATE A FILE
+1 SET %=$$DIR^XBDIR("Y","Create a file","N","","","^D HELP^ACHS(""H2"",""ACHSVUR2"")",2)
+2 IF $DATA(DUOUT)
GOTO TYPE
IF $DATA(DTOUT)
GOTO EXIT
+3 SET BMCFIL=$SELECT(%:"Y",1:"N")
ZIS ;call to XBDBQUE
+1 KILL BMCOPT
+2 WRITE !
SET DIR(0)="S^P:PRINT Output;B:BROWSE Output on Screen"
SET DIR("A")="Do you wish to"
SET DIR("B")="P"
KILL DA
DO ^DIR
KILL DIR
+3 IF $DATA(DIRUT)
SET BMCQUIT=""
QUIT
+4 SET BMCOPT=Y
+5 IF $GET(BMCQUIT)
GOTO FILE
+6 IF $GET(BMCOPT)="B"
DO BROWSE
DO EXIT
QUIT
+7 SET XBRP="^BMCRR23P"
SET XBRC="STPROC^BMCRR23"
SET XBRX="EXIT^BMCRR23"
SET XBNS="BMC"
+8 DO ^XBDBQUE
+9 QUIT
BROWSE ;
+1 SET XBRP="VIEWR^XBLM(""^BMCRR23P"")"
+2 SET XBRC="STPROC^BMCRR23"
SET XBIOP=0
DO ^XBDBQUE
+3 QUIT
FIL2 ;CREATE THE FILE
+1 DO FILHDR^BMCRR23P
+2 DO FILSUM^BMCRR23P
+3 DO FILSAV^BMCRR23P
+4 QUIT
EXIT ;
+1 IF $DATA(BMCFIL)
IF BMCFIL="Y"
DO FIL2
+2 DO KILL^AUPNPAT
+3 KILL BMC80D,BMC80E,BMCBT,BMCBTH,BMCET,BMCOPT,BMCPG,BMCQUIT,BMCRCNT,BMCREF,BMCRREC,BMCSORT,BMCSTYPE
+4 KILL BMCBD,BMCED,BMCBDD,BMCEDD,BMCSD,BMCRTYP,BMCFIL,BMCRTH,BMCCHS,BMCHIT,BMCJOB,BMCODAT,BMCPDT,BMCRPT
+5 KILL BMCCFC,BMCCHS0,BMCCPO,BMCPOC,BMCR,BMCRCDAY,BMCRCTOT,BMCREC,BMCRPO,BMCRRDAY,BMCRRTOT,BMCRTOT,BMCSRTH,BMCTAVG
+6 KILL DA,DFN,DIR,X,Y
+7 KILL ^XTMP($JOB,"BMCRR23")
+8 QUIT
PCCTST ;IF SITE DOES NOT USE PCC LINK THE EARLIEST DATE FOR REPORT WILL BE WHEN V4 P12 WAS INSTALLED
+1 SET BMCPDT=""
SET BMCPDT=""
+2 IF $PIECE(^BMCPARM(DUZ(2),0),U,3)<1
SET BMCPDT=$PIECE(^BMCPARM(DUZ(2),4100),U,12)
SET Y=BMCPDT
DO DD^%DT
SET BMCPDT1=Y
+3 QUIT
STPROC ;
+1 SET (BMCBT,BMCBTH)=$HOROLOG
SET BMCRCNT=0
+2 DO PROCESS
DO END
+3 QUIT
+4 ;
PROCESS ;
+1 SET BMCODAT=$ORDER(^BMCREF("B",BMCSD))
IF BMCODAT=""
SET BMCET=$HOROLOG
QUIT
+2 SET BMCODAT=BMCSD_".9999"
+3 FOR
SET BMCODAT=$ORDER(^BMCREF("B",BMCODAT))
IF BMCODAT=""!((BMCODAT\1)>BMCED)
QUIT
DO R1
+4 QUIT
+5 ;
R1 ;
+1 SET BMCREF=""
+2 FOR
SET BMCREF=$ORDER(^BMCREF("B",BMCODAT,BMCREF))
IF BMCREF'=+BMCREF
QUIT
SET BMCRREC=^BMCREF(BMCREF,0)
DO PROCESS2
+3 QUIT
+4 ;
END ;
+1 SET BMCET=$HOROLOG
+2 QUIT
PROCESS2 ;
+1 SET BMCRREC=^BMCREF(BMCREF,0)
SET DFN=$PIECE(BMCRREC,U,3)
SET BMCSORT="R"
+2 ;TEST FOR CHS REFERRAL
+3 IF $PIECE(BMCRREC,U,4)'="C"
QUIT
+4 ;TEST FOR PRIMARY REFERRAL
+5 IF $PIECE($GET(^BMCREF(BMCREF,1)),U)'=""
QUIT
+6 ;TEST FOR PO AND PAID
+7 IF ($PIECE($GET(^BMCREF(BMCREF,11)),U,15)<1)&($PIECE($GET(^BMCREF(BMCREF,11)),U,16)<0)
QUIT
+8 ;TEST FOR 0 THIRD PARTY PAY, FINAL PAY AND FIRST PO ENTERED
+9 SET L=0
SET BMCCHS=""
SET BMCHIT=""
+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,5)>0
QUIT
+13 IF $PIECE($GET(^ACHSF(DUZ(2),"D",BMCCHS,"PA")),U,4)="F"
SET BMCHIT=1
End DoDot:1
+14 IF BMCHIT<1
QUIT
+15 ;NOTIFICATION or PCC VISIT - Will be considered a call in if PCC link is on
+16 ;PCC LINK AND CALL IN
IF BMCPDT
IF $PIECE($GET(^BMCREF(BMCREF,1)),U,4)'=""
SET BMCSORT="C"
GOTO SET
+17 ;CALLIN OR NO VISIT
IF ($PIECE($GET(^BMCREF(BMCREF,1)),U,4)'="")!($PIECE($GET(^BMCREF(BMCREF,13)),U,9)="")
SET BMCSORT="C"
SET ;
+1 IF ((BMCSORT="C")&(BMCRPT="N"))
QUIT
+2 IF ((BMCSORT="R")&(BMCRPT="C"))
QUIT
+3 IF $PIECE(^BMCREF(BMCREF,0),U,5)'=DUZ(2)
QUIT
+4 SET ^XTMP(BMCJOB,"BMCRR23",BMCBTH,"DATA HITS",DUZ(2),BMCSORT,BMCREF)=""
SET BMCRCNT=BMCRCNT+1
+5 QUIT
