BMCRRSP1.m

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

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

 ;;IHS/ITSC/FCJ  ADDED TEST OF REFERRAL TYPES

 ;;4.0 IHS/ITSC/FCJ CHG TO PROC DATA FROM RCIS REF FILE

START ;

 S (BMCBT,BMCBTH)=$H,BMCJOB=$J,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 BMCRDT="" F  S BMCRDT=$O(^BMCREF("B",BMCODAT,BMCRDT)) Q:BMCRDT'=+BMCRDT  S BMCRREC=^BMCREF(BMCRDT,0) D PROC

 Q

END ;

 S BMCET=$H

 Q

PROC ;

 Q:'$D(^BMCREF(BMCRDT,0))

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

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

 S BMCREF=$P(^BMCREF(BMCRDT,1),U,2)

 S BMCREVP=$P(BMCRREC,U,25) ;user

 S BMCSPRV=$P(BMCRREC,U,7) ;Provider/Vendor IEN

 S:BMCSPRV'="" BMCSPRV=$P(^AUTTVNDR(BMCSPRV,0),U)

 S BMCAPPT=$P(^BMCREF(BMCRDT,11),U,5) ;Exp Appt Date

 S BMCPUR=$P($G(^BMCREF(BMCRDT,12)),U) ; Purpose

 S BMCIHSP=$P(BMCRREC,U,8) ;IHS Facility

 ;

 Q:$P(^BMCREF(BMCRDT,0),U,4)="N"

 I BMCCTYP'="A",$P(^BMCREF(BMCRDT,0),U,4)'=BMCCTYP Q

 Q:$P(^BMCREF(BMCRDT,0),U,5)'=BMCFAC

 I BMCCREV'=0,(BMCCREV'=BMCREVP) Q

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

 Q

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

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

 +2       ;;IHS/ITSC/FCJ  ADDED TEST OF REFERRAL TYPES

 +3       ;;4.0 IHS/ITSC/FCJ CHG TO PROC DATA FROM RCIS REF FILE

START     ;

 +1        SET (BMCBT,BMCBTH)=$HOROLOG

           SET BMCJOB=$JOB

           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"

           FOR 

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

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

                   QUIT 

               DO R1

 +3        QUIT 

 +4       ;

R1        ;

 +1        SET BMCRDT=""

           FOR 

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

               IF BMCRDT'=+BMCRDT

                   QUIT 

               SET BMCRREC=^BMCREF(BMCRDT,0)

               DO PROC

 +2        QUIT 

END       ;

 +1        SET BMCET=$HOROLOG

 +2        QUIT 

PROC      ;

 +1        IF '$DATA(^BMCREF(BMCRDT,0))

               QUIT 

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

               QUIT 

 +3        SET BMCRREC=^BMCREF(BMCRDT,0)

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

           SET BMCDATE=$PIECE(BMCRREC,U,1)

 +4        SET BMCREF=$PIECE(^BMCREF(BMCRDT,1),U,2)

 +5       ;user

           SET BMCREVP=$PIECE(BMCRREC,U,25)

 +6       ;Provider/Vendor IEN

           SET BMCSPRV=$PIECE(BMCRREC,U,7)

 +7        IF BMCSPRV'=""

               SET BMCSPRV=$PIECE(^AUTTVNDR(BMCSPRV,0),U)

 +8       ;Exp Appt Date

           SET BMCAPPT=$PIECE(^BMCREF(BMCRDT,11),U,5)

 +9       ; Purpose

           SET BMCPUR=$PIECE($GET(^BMCREF(BMCRDT,12)),U)

 +10      ;IHS Facility

           SET BMCIHSP=$PIECE(BMCRREC,U,8)

 +11      ;

 +12       IF $PIECE(^BMCREF(BMCRDT,0),U,4)="N"

               QUIT 

 +13       IF BMCCTYP'="A"

               IF $PIECE(^BMCREF(BMCRDT,0),U,4)'=BMCCTYP

                   QUIT 

 +14       IF $PIECE(^BMCREF(BMCRDT,0),U,5)'=BMCFAC

               QUIT 

 +15       IF BMCCREV'=0

               IF (BMCCREV'=BMCREVP)

                   QUIT 

 +16       SET ^XTMP("BMCRRSP",BMCJOB,BMCBTH,"DATA HITS",BMCDATE,$PIECE(^DPT(DFN,0),U),BMCRDT)=""

           SET BMCRCNT=BMCRCNT+1

 +17       QUIT