BMCRR31.m

BMCRR31 ; IHS/OHPRD/TMJ - PROCESS REFERRAL LIST ;  

 ;;4.0;REFERRED CARE INFO SYSTEM;;JAN 09, 2006

 ;IHS/ITSC/FCJ TEST FOR SR, SKIP SINCE NO COST DATA IS ENTERED

 ;

 ;

START ;

 S (BMCBT,BMCBTH)=$H,BMCJOB=$J,BMCRCNT=0

 D PROCESS,END

 Q

 ;

PROCESS ;

 ;

V ; Run by visit date

 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 PROC

 Q

 ;

END ;

 S BMCET=$H

 Q

PROC ;

 S BMCREF="" F  S BMCREF=$O(^BMCREF("B",BMCODAT,BMCREF)) Q:BMCREF'=+BMCREF  S BMCRREC=^BMCREF(BMCREF,0),DFN=$P(BMCRREC,U,3) D PROCR

 Q

 ;

PROCR ;

 Q:$P(BMCRREC,U,4)="N"

 Q:$P($G(^BMCREF(BMCREF,1)),U)'=""

 I '$D(^XTMP("BMCRR3",BMCJOB,BMCBTH,"DATA HITS",$P(^DPT(DFN,0),U),DFN)) S ^XTMP("BMCRR3",BMCJOB,BMCBTH,"DATA HITS",$P(^DPT(DFN,0),U),DFN)=""

 I BMCCOST="I" S BMCDOLL=$$AVICOST^BMCRLU(BMCREF)

 I BMCCOST="T" S BMCDOLL=$$AVTCOST^BMCRLU(BMCREF)

 S $P(^XTMP("BMCRR3",BMCJOB,BMCBTH,"DATA HITS",$P(^DPT(DFN,0),U),DFN),U)=$P(^XTMP("BMCRR3",BMCJOB,BMCBTH,"DATA HITS",$P(^DPT(DFN,0),U),DFN),U)+1

 S $P(^XTMP("BMCRR3",BMCJOB,BMCBTH,"DATA HITS",$P(^DPT(DFN,0),U),DFN),U,2)=$P(^XTMP("BMCRR3",BMCJOB,BMCBTH,"DATA HITS",$P(^DPT(DFN,0),U),DFN),U,2)+BMCDOLL

 Q

BMCRR31   ; IHS/OHPRD/TMJ - PROCESS REFERRAL LIST ;  

 +1       ;;4.0;REFERRED CARE INFO SYSTEM;;JAN 09, 2006

 +2       ;IHS/ITSC/FCJ TEST FOR SR, SKIP SINCE NO COST DATA IS ENTERED

 +3       ;

 +4       ;

START     ;

 +1        SET (BMCBT,BMCBTH)=$HOROLOG

           SET BMCJOB=$JOB

           SET BMCRCNT=0

 +2        DO PROCESS

           DO END

 +3        QUIT 

 +4       ;

PROCESS   ;

 +1       ;

V         ; Run by visit date

 +1        SET BMCODAT=$ORDER(^BMCREF("B",BMCSD))

           IF BMCODAT=""

               SET BMCET=$HOROLOG

               QUIT 

 +2        SET BMCODAT=BMCSD_".9999"

           FOR 

               SET BMCODAT=$ORDER(^BMCREF("B",BMCODAT))

               IF BMCODAT=""!((BMCODAT\1)>BMCED)

                   QUIT 

               DO PROC

 +3        QUIT 

 +4       ;

END       ;

 +1        SET BMCET=$HOROLOG

 +2        QUIT 

PROC      ;

 +1        SET BMCREF=""

           FOR 

               SET BMCREF=$ORDER(^BMCREF("B",BMCODAT,BMCREF))

               IF BMCREF'=+BMCREF

                   QUIT 

               SET BMCRREC=^BMCREF(BMCREF,0)

               SET DFN=$PIECE(BMCRREC,U,3)

               DO PROCR

 +2        QUIT 

 +3       ;

PROCR     ;

 +1        IF $PIECE(BMCRREC,U,4)="N"

               QUIT 

 +2        IF $PIECE($GET(^BMCREF(BMCREF,1)),U)'=""

               QUIT 

 +3        IF '$DATA(^XTMP("BMCRR3",BMCJOB,BMCBTH,"DATA HITS",$PIECE(^DPT(DFN,0),U),DFN))

               SET ^XTMP("BMCRR3",BMCJOB,BMCBTH,"DATA HITS",$PIECE(^DPT(DFN,0),U),DFN)=""

 +4        IF BMCCOST="I"

               SET BMCDOLL=$$AVICOST^BMCRLU(BMCREF)

 +5        IF BMCCOST="T"

               SET BMCDOLL=$$AVTCOST^BMCRLU(BMCREF)

 +6        SET $PIECE(^XTMP("BMCRR3",BMCJOB,BMCBTH,"DATA HITS",$PIECE(^DPT(DFN,0),U),DFN),U)=$PIECE(^XTMP("BMCRR3",BMCJOB,BMCBTH,"DATA HITS",$PIECE(^DPT(DFN,0),U),DFN),U)+1

 +7        SET $PIECE(^XTMP("BMCRR3",BMCJOB,BMCBTH,"DATA HITS",$PIECE(^DPT(DFN,0),U),DFN),U,2)=$PIECE(^XTMP("BMCRR3",BMCJOB,BMCBTH,"DATA HITS",$PIECE(^DPT(DFN,0),U),DFN),U,2)+BMCDOLL

 +8        QUIT