- 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