BMCRR11.m

BMCRR11 ; IHS/PHXAO/TMJ - PROCESS REFERRAL LIST ;    

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

 ;IHS/ITSC/FCJ ADDED TEST FOR SR

 ;

 ;

START ;

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

 D PROCESS,END

 Q

 ;

PROCESS ;

 S BMCREF=0 F  S BMCREF=$O(^BMCREF(BMCREF)) Q:BMCREF'=+BMCREF  D PROC

 Q

 ;

END ;

 S BMCET=$H

 Q

PROC ;

 K BMCSPEC

 S BMCRREC=^BMCREF(BMCREF,0),DFN=$P(BMCRREC,U,3)

 ;Q:$P(BMCRREC,U,4)="C"  ;Quit if not a CHS Type Referral

 Q:$P(BMCRREC,U,18)'=""  ;Quit if Letter has been received

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

 Q:$P($G(^BMCREF(BMCREF,1)),U)'=""  ;QUIT IF SR

 ;Get Referred To Facility IEN Number

 S BMCFAC1=$S($P(BMCRREC,U,7)'="":$P(BMCRREC,U,7),$P(BMCRREC,U,8)'="":$P(BMCRREC,U,8),$P(BMCRREC,U,9)'="":$P(BMCRREC,U,9),1:"")

 Q:'BMCFAC1

 Q:BMCFAC'=""&(BMCFAC'=BMCFAC1)  ;Quit if Selected Fac no match

 Q:$P(BMCRREC,U,29)]""

 ;Q:$P($G(^BMCREF(BMCREF,11)),U,8)=""  ;no actual end date of service commented out per Stan 9/9/96

 ;Q:$P(BMCRREC,U,15)'="C1"

 I $P(BMCRREC,U,15)'="A"&($P(BMCRREC,U,15)'="C1") Q

 I BMCTIME>$$FMDIFF^XLFDT(DT,$P($G(^BMCREF(BMCREF,11)),U,8)) Q

 ;check for medical and/or cost

 ;get sort value

 D @BMCSTYPE

 I BMCSORT="" S BMCSORT="??"

 S ^TMP("BMCRR1",BMCJOB,BMCBTH,"DATA HITS",BMCSORT,BMCREF)="",BMCRCNT=BMCRCNT+1

 Q

F ;

 ;S BMCSORT=$P($G(^AUTTVNDR(BMCFAC1,0)),U)

 S BMCSORT=$$FACREF^BMCRLU(BMCREF)

 Q

T ;

 S BMCSORT=$$FMDIFF^XLFDT(DT,$P($G(^BMCREF(BMCREF,11)),U,8))

 S BMCSORT=BMCSORT\30

 S BMCSORT=$S(BMCSORT>6:1,BMCSORT>3:2,BMCSORT>1:3,1:4)

 Q

BMCRR11   ; IHS/PHXAO/TMJ - PROCESS REFERRAL LIST ;    

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

 +2       ;IHS/ITSC/FCJ ADDED TEST FOR SR

 +3       ;

 +4       ;

START     ;

 +1        SET (BMCBT,BMCBTH)=$HOROLOG

           SET BMCJOB=$JOB

           SET BMCRCNT=0

 +2        DO PROCESS

           DO END

 +3        QUIT 

 +4       ;

PROCESS   ;

 +1        SET BMCREF=0

           FOR 

               SET BMCREF=$ORDER(^BMCREF(BMCREF))

               IF BMCREF'=+BMCREF

                   QUIT 

               DO PROC

 +2        QUIT 

 +3       ;

END       ;

 +1        SET BMCET=$HOROLOG

 +2        QUIT 

PROC      ;

 +1        KILL BMCSPEC

 +2        SET BMCRREC=^BMCREF(BMCREF,0)

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

 +3       ;Q:$P(BMCRREC,U,4)="C"  ;Quit if not a CHS Type Referral

 +4       ;Quit if Letter has been received

           IF $PIECE(BMCRREC,U,18)'=""

               QUIT 

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

               QUIT 

 +6       ;QUIT IF SR

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

               QUIT 

 +7       ;Get Referred To Facility IEN Number

 +8        SET BMCFAC1=$SELECT($PIECE(BMCRREC,U,7)'="":$PIECE(BMCRREC,U,7),$PIECE(BMCRREC,U,8)'="":$PIECE(BMCRREC,U,8),$PIECE(BMCRREC,U,9)'="":$PIECE(BMCRREC,U,9),1:"")

 +9        IF 'BMCFAC1

               QUIT 

 +10      ;Quit if Selected Fac no match

           IF BMCFAC'=""&(BMCFAC'=BMCFAC1)

               QUIT 

 +11       IF $PIECE(BMCRREC,U,29)]""

               QUIT 

 +12      ;Q:$P($G(^BMCREF(BMCREF,11)),U,8)=""  ;no actual end date of service commented out per Stan 9/9/96

 +13      ;Q:$P(BMCRREC,U,15)'="C1"

 +14       IF $PIECE(BMCRREC,U,15)'="A"&($PIECE(BMCRREC,U,15)'="C1")

               QUIT 

 +15       IF BMCTIME>$$FMDIFF^XLFDT(DT,$PIECE($GET(^BMCREF(BMCREF,11)),U,8))

               QUIT 

 +16      ;check for medical and/or cost

 +17      ;get sort value

 +18       DO @BMCSTYPE

 +19       IF BMCSORT=""

               SET BMCSORT="??"

 +20       SET ^TMP("BMCRR1",BMCJOB,BMCBTH,"DATA HITS",BMCSORT,BMCREF)=""

           SET BMCRCNT=BMCRCNT+1

 +21       QUIT 

F         ;

 +1       ;S BMCSORT=$P($G(^AUTTVNDR(BMCFAC1,0)),U)

 +2        SET BMCSORT=$$FACREF^BMCRLU(BMCREF)

 +3        QUIT 

T         ;

 +1        SET BMCSORT=$$FMDIFF^XLFDT(DT,$PIECE($GET(^BMCREF(BMCREF,11)),U,8))

 +2        SET BMCSORT=BMCSORT\30

 +3        SET BMCSORT=$SELECT(BMCSORT>6:1,BMCSORT>3:2,BMCSORT>1:3,1:4)

 +4        QUIT