BMCRR171.m

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

 ;;4.0;REFERRED CARE INFO SYSTEM;**9**;JAN 09, 2006;Build 101

 ;

START ;

 S (BMCBT,BMCBTH)=$H,BMCJOB=$J,BMCRCNT=0,BMCNOES=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 ;

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

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

 Q:$P(BMCRREC,U,14)'="I"

 ;Q:$P(BMCRREC,U,15)'="A"  ;QUIT IF NOT ACTIVE  ;BMC*4.0*9 IHS.OIT.FCJ

 Q:($P(BMCRREC,U,15)="C1")!($P(BMCRREC,U,15)="X")  ;QUIT IF NOT ACTIVE OR APPROVED ;BMC*4.0*9 IHS.OIT.FCJ

 Q:$$AVDOS^BMCRLU(BMCREF,"I")=""  ;QUIT IF NO EST OR ACTUAL BEG DOS

 Q:$$AVDOS^BMCRLU(BMCREF,"I")>DT  ;QUIT IF DOS IS AFTER TODAY

 I $P($G(^BMCREF(BMCREF,11)),U,8)]"" Q  ;quit if actual discharge date present

 I $$VAL^XBDIQ1(90001,BMCREF,1109)="" S BMCNOES=BMCNOES+1

 S BMCALOS=$$VAL^XBDIQ1(90001,BMCREF,.1499)

 S BMCELOS=$$VAL^XBDIQ1(90001,BMCREF,1109)

 Q:BMCALOS=BMCELOS

 Q:BMCALOS<BMCELOS

 ;get sort value

 S BMCSORT=""

 D @BMCSTYPE

 S:BMCSORT="" BMCSORT="??"

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

 Q

F ;sort by facility

 S BMCSORT=$$FACREF^BMCRLU(BMCREF)

 Q

P ;sort by patient name

 S BMCSORT=$P(^DPT(DFN,0),U)

 Q

C ;sort by case manager

 S BMCSORT=$$CASEMAN^BMCRLU(BMCREF)

 Q

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

 +1       ;;4.0;REFERRED CARE INFO SYSTEM;**9**;JAN 09, 2006;Build 101

 +2       ;

START     ;

 +1        SET (BMCBT,BMCBTH)=$HOROLOG

           SET BMCJOB=$JOB

           SET BMCRCNT=0

           SET BMCNOES=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        SET BMCRREC=^BMCREF(BMCREF,0)

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

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

               QUIT 

 +3        IF $PIECE(BMCRREC,U,14)'="I"

               QUIT 

 +4       ;Q:$P(BMCRREC,U,15)'="A"  ;QUIT IF NOT ACTIVE  ;BMC*4.0*9 IHS.OIT.FCJ

 +5       ;QUIT IF NOT ACTIVE OR APPROVED ;BMC*4.0*9 IHS.OIT.FCJ

           IF ($PIECE(BMCRREC,U,15)="C1")!($PIECE(BMCRREC,U,15)="X")

               QUIT 

 +6       ;QUIT IF NO EST OR ACTUAL BEG DOS

           IF $$AVDOS^BMCRLU(BMCREF,"I")=""

               QUIT 

 +7       ;QUIT IF DOS IS AFTER TODAY

           IF $$AVDOS^BMCRLU(BMCREF,"I")>DT

               QUIT 

 +8       ;quit if actual discharge date present

           IF $PIECE($GET(^BMCREF(BMCREF,11)),U,8)]""

               QUIT 

 +9        IF $$VAL^XBDIQ1(90001,BMCREF,1109)=""

               SET BMCNOES=BMCNOES+1

 +10       SET BMCALOS=$$VAL^XBDIQ1(90001,BMCREF,.1499)

 +11       SET BMCELOS=$$VAL^XBDIQ1(90001,BMCREF,1109)

 +12       IF BMCALOS=BMCELOS

               QUIT 

 +13       IF BMCALOS<BMCELOS

               QUIT 

 +14      ;get sort value

 +15       SET BMCSORT=""

 +16       DO @BMCSTYPE

 +17       IF BMCSORT=""

               SET BMCSORT="??"

 +18       SET ^XTMP("BMCRR17",BMCJOB,BMCBTH,"DATA HITS",BMCSORT,BMCREF)=""

           SET BMCRCNT=BMCRCNT+1

 +19       QUIT 

F         ;sort by facility

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

 +2        QUIT 

P         ;sort by patient name

 +1        SET BMCSORT=$PIECE(^DPT(DFN,0),U)

 +2        QUIT 

C         ;sort by case manager

 +1        SET BMCSORT=$$CASEMAN^BMCRLU(BMCREF)

 +2        QUIT