GMRCRA.m

GMRCRA ;SLC/DLT - Build ^TMP("GMRCR",$J, array of consults ;15-Mar-2012 10:41;PLS

 ;;3.0;CONSULT/REQUEST TRACKING;**1,1001,1003**;DEC 27, 1997;Build 14

 ;Modified - IHS/CIA/MGH - 11/29/2005 - Line END+1  - Code changed to use HRCN instead of SSN

AD ;Loop thru AD cross reference

 D PRE

 S GMRCD=0 F  S GMRCD=$O(^GMR(123,"AD",DFN,GMRCD)) Q:'GMRCD!($D(GMRCQIT))  S GMRCDA=0 F  S GMRCDA=$O(^GMR(123,"AD",DFN,GMRCD,GMRCDA)) Q:'GMRCDA!($D(GMRCQIT))  D ADBUILD Q:$D(GMRCQIT)

 S GMRCTC=GMRCT

 Q

ADBUILD ;Check for Service Match

 I $P(^GMR(123,GMRCDA,0),"^",5),'$D(^TMP("GMRCS",$J,$P(^(0),"^",5))) Q

 D BUILD Q

AESS ;Build array based on service (variable GMRCSS) and single patient

 D PRE

 I '$D(^TMP("GMRCS",$J)) Q:'$D(GMRC1)  D:GMRC1 AECONT Q

 E  S GMRCTO="" F  S GMRCTO=$O(^TMP("GMRCS",$J,GMRCTO)) Q:GMRCTO=""  S GMRC1=GMRCTO D AECONT

 S GMRCTC=GMRCT S GMRCT=$S(GMRCT:1,1:0) ;INITIALIZE COUNT TO 1 FOR HDR

 Q

AECONT S GMRC2=0 F  S GMRC2=$O(^GMR(123,"AE",GMRC1,DFN,GMRC2)) Q:'GMRC2!($D(GMRCQIT))  S GMRCDA=0 F  S GMRCDA=$O(^GMR(123,"AE",GMRC1,DFN,GMRC2,GMRCDA)) Q:'GMRCDA!($D(GMRCQIT))  D BUILD Q:$D(GMRCQIT)

 Q

BUILD ;Build array

 Q:$P(^GMR(123,GMRCDA,0),"^",12)=11  ;Do not include unreleased orders

 S GMRCT=GMRCT+1,^TMP("GMRCR",$J,GMRCT,0)=^GMR(123,GMRCDA,0)

 S:$D(^GMR(123,GMRCDA,30)) ^TMP("GMRCR",$J,GMRCT,30)=^(30)

 S ^TMP("GMRCR",$J,GMRCT,"DA")=GMRCDA

 Q

PRE ;Setup for creating array of consults

 S (GMRCTC,GMRCT,GMRC2,GMRCDA)=0,GMRC1=GMRCSS K GMRC,^TMP("GMRCR",$J)

 Q

END K GMRCD,GMRCDA,%T,DIC,GMRC,GMRCLO,GMRCPNM,GMRCRB,GMRCWARD,GMRCDOB,DIC,X,Y,VA,VAIN,VAINDT,VADM,VAEL,VAPA,VAERR,GMRCSN,GMRCHRCN,GMRC0,GMRC1,GMRC2  ;IHS/CIA/MGH

GMRCRA    ;SLC/DLT - Build ^TMP("GMRCR",$J, array of consults ;15-Mar-2012 10:41;PLS

 +1       ;;3.0;CONSULT/REQUEST TRACKING;**1,1001,1003**;DEC 27, 1997;Build 14

 +2       ;Modified - IHS/CIA/MGH - 11/29/2005 - Line END+1  - Code changed to use HRCN instead of SSN

AD        ;Loop thru AD cross reference

 +1        DO PRE

 +2        SET GMRCD=0

           FOR 

               SET GMRCD=$ORDER(^GMR(123,"AD",DFN,GMRCD))

               IF 'GMRCD!($DATA(GMRCQIT))

                   QUIT 

               SET GMRCDA=0

               FOR 

                   SET GMRCDA=$ORDER(^GMR(123,"AD",DFN,GMRCD,GMRCDA))

                   IF 'GMRCDA!($DATA(GMRCQIT))

                       QUIT 

                   DO ADBUILD

                   IF $DATA(GMRCQIT)

                       QUIT 

 +3        SET GMRCTC=GMRCT

 +4        QUIT 

ADBUILD   ;Check for Service Match

 +1        IF $PIECE(^GMR(123,GMRCDA,0),"^",5)

               IF '$DATA(^TMP("GMRCS",$JOB,$PIECE(^(0),"^",5)))

                   QUIT 

 +2        DO BUILD

           QUIT 

AESS      ;Build array based on service (variable GMRCSS) and single patient

 +1        DO PRE

 +2        IF '$DATA(^TMP("GMRCS",$JOB))

               IF '$DATA(GMRC1)

                   QUIT 

               IF GMRC1

                   DO AECONT

               QUIT 

 +3       IF '$TEST

               SET GMRCTO=""

               FOR 

                   SET GMRCTO=$ORDER(^TMP("GMRCS",$JOB,GMRCTO))

                   IF GMRCTO=""

                       QUIT 

                   SET GMRC1=GMRCTO

                   DO AECONT

 +4       ;INITIALIZE COUNT TO 1 FOR HDR

           SET GMRCTC=GMRCT

           SET GMRCT=$SELECT(GMRCT:1,1:0)

 +5        QUIT 

AECONT     SET GMRC2=0

           FOR 

               SET GMRC2=$ORDER(^GMR(123,"AE",GMRC1,DFN,GMRC2))

               IF 'GMRC2!($DATA(GMRCQIT))

                   QUIT 

               SET GMRCDA=0

               FOR 

                   SET GMRCDA=$ORDER(^GMR(123,"AE",GMRC1,DFN,GMRC2,GMRCDA))

                   IF 'GMRCDA!($DATA(GMRCQIT))

                       QUIT 

                   DO BUILD

                   IF $DATA(GMRCQIT)

                       QUIT 

 +1        QUIT 

BUILD     ;Build array

 +1       ;Do not include unreleased orders

           IF $PIECE(^GMR(123,GMRCDA,0),"^",12)=11

               QUIT 

 +2        SET GMRCT=GMRCT+1

           SET ^TMP("GMRCR",$JOB,GMRCT,0)=^GMR(123,GMRCDA,0)

 +3        IF $DATA(^GMR(123,GMRCDA,30))

               SET ^TMP("GMRCR",$JOB,GMRCT,30)=^(30)

 +4        SET ^TMP("GMRCR",$JOB,GMRCT,"DA")=GMRCDA

 +5        QUIT 

PRE       ;Setup for creating array of consults

 +1        SET (GMRCTC,GMRCT,GMRC2,GMRCDA)=0

           SET GMRC1=GMRCSS

           KILL GMRC,^TMP("GMRCR",$JOB)

 +2        QUIT 

END       ;IHS/CIA/MGH

           KILL GMRCD,GMRCDA,%T,DIC,GMRC,GMRCLO,GMRCPNM,GMRCRB,GMRCWARD,GMRCDOB,DIC,X,Y,VA,VAIN,VAINDT,VADM,VAEL,VAPA,VAERR,GMRCSN,GMRCHRCN,GMRC0,GMRC1,GMRC2