BMCRCRV1.m

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

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

 ;

 ;

 ;

START ;

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

 D PROCESS,END

 Q

 ;

PROCESS ;

 S BMCREF="" F  S BMCREF=$O(^BMCCOM("AC",BMCREF)) Q:BMCREF=""

 ;S BMCODAT=BMCSD_".9999" F  S BMCODAT=$O(^BMCCOM("B",BMCODAT)) Q:BMCODAT=""!((BMCODAT\1)>BMCED)  D R1

 I BMCREF="" S BMCET=$H Q  D R1

 Q

 ;

R1 ;

 ;S BMCCDT="" F  S BMCCDT=$O(^BMCCOM("B",BMCODAT,BMCCDT)) Q:BMCCDT'=+BMCCDT  S BMCRREC=^BMCCOM(BMCCDT,0) D PROC

 S BMCIEN="" F  S BMCIEN=$O(^BMCCOM("AC",BMCREF,BMCIEN)) Q:BMCIEN'=+BMCIEN  S BMCRREC=^BMCCOM(BMCIEN,0) D PROC

 Q

END ;

 S BMCET=$H

 Q

PROC ;

 S BMCCDT=$P(BMCRREC,U,1),DFN=$P(BMCRREC,U,2)

 S BMCODAT=BMCCDT Q:BMCODAT=""!(BMCODATE\1)>BMCED

 ;S BMCRREC=^BMCCOM(BMCCDT,0),DFN=$P(BMCRREC,U,2)

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

 S BMCDATE=$S($$AVDOS^BMCRLU(BMCCDT,"I")]"":$$AVDOS^BMCRLU(BMCCDT,"I"),1:"<none>")

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

 Q

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

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

 +2       ;

 +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=""

           FOR 

               SET BMCREF=$ORDER(^BMCCOM("AC",BMCREF))

               IF BMCREF=""

                   QUIT 

 +2       ;S BMCODAT=BMCSD_".9999" F  S BMCODAT=$O(^BMCCOM("B",BMCODAT)) Q:BMCODAT=""!((BMCODAT\1)>BMCED)  D R1

 +3        IF BMCREF=""

               SET BMCET=$HOROLOG

               QUIT 

               DO R1

 +4        QUIT 

 +5       ;

R1        ;

 +1       ;S BMCCDT="" F  S BMCCDT=$O(^BMCCOM("B",BMCODAT,BMCCDT)) Q:BMCCDT'=+BMCCDT  S BMCRREC=^BMCCOM(BMCCDT,0) D PROC

 +2        SET BMCIEN=""

           FOR 

               SET BMCIEN=$ORDER(^BMCCOM("AC",BMCREF,BMCIEN))

               IF BMCIEN'=+BMCIEN

                   QUIT 

               SET BMCRREC=^BMCCOM(BMCIEN,0)

               DO PROC

 +3        QUIT 

END       ;

 +1        SET BMCET=$HOROLOG

 +2        QUIT 

PROC      ;

 +1        SET BMCCDT=$PIECE(BMCRREC,U,1)

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

 +2        SET BMCODAT=BMCCDT

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

               QUIT 

 +3       ;S BMCRREC=^BMCCOM(BMCCDT,0),DFN=$P(BMCRREC,U,2)

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

               QUIT 

 +5        SET BMCDATE=$SELECT($$AVDOS^BMCRLU(BMCCDT,"I")]"":$$AVDOS^BMCRLU(BMCCDT,"I"),1:"<none>")

 +6        SET ^XTMP("BMCRCRV",BMCJOB,BMCBTH,"DATA HITS",BMCDATE,$PIECE(^DPT(DFN,0),U),BMCCDT)=""

           SET BMCRCNT=BMCRCNT+1

 +7        QUIT