BMCRR81.m

BMCRR81 ; 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 ;

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 R1

 Q

 ;

END ;

 S BMCET=$H

 Q

R1 ;

 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(BMCRREC,U,15)="X"

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

 I '$D(^BMCDX("AD",BMCREF)) Q  ;no icd codes/cpt codes

 S (BMCX,BMCFOUN)=0 F  S BMCX=$O(^BMCDX("AD",BMCREF,BMCX)) Q:BMCX'=+BMCX!(BMCFOUN)  S BMCFOUN=$$TXC^ATXTXCHK(+^BMCDX(BMCX,0),BMCHCTAX)

 Q:'BMCFOUN

 S ^XTMP("BMCRR8",BMCJOB,BMCBTH,"DATA HITS",$P(^DPT(DFN,0),U),DFN,BMCREF)=""

 Q

BMCRR81   ; 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   ;

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 R1

 +3        QUIT 

 +4       ;

END       ;

 +1        SET BMCET=$HOROLOG

 +2        QUIT 

R1        ;

 +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 

PROCR     ;

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

               QUIT 

 +2        IF $PIECE(BMCRREC,U,15)="X"

               QUIT 

 +3       ;QUIT IF SR

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

               QUIT 

 +4       ;no icd codes/cpt codes

           IF '$DATA(^BMCDX("AD",BMCREF))

               QUIT 

 +5        SET (BMCX,BMCFOUN)=0

           FOR 

               SET BMCX=$ORDER(^BMCDX("AD",BMCREF,BMCX))

               IF BMCX'=+BMCX!(BMCFOUN)

                   QUIT 

               SET BMCFOUN=$$TXC^ATXTXCHK(+^BMCDX(BMCX,0),BMCHCTAX)

 +6        IF 'BMCFOUN

               QUIT 

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

 +8        QUIT