GMRCRA.m

GMRCRA ;SLC/DLT - Build ^TMP("GMRCR",$J, array of consults ;5/20/98  14:20

 ;;3.0;CONSULT/REQUEST TRACKING;**1**;DEC 27, 1997

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,GMRC0,GMRC1,GMRC2

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---GMRCRA   1520     printed  Apr 09, 2024@20:50:03                                                                                                                                                                                                      Page 2

GMRCRA    ;SLC/DLT - Build ^TMP("GMRCR",$J, array of consults ;5/20/98  14:20

 +1       ;;3.0;CONSULT/REQUEST TRACKING;**1**;DEC 27, 1997

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        KILL GMRCD,GMRCDA,%T,DIC,GMRC,GMRCLO,GMRCPNM,GMRCRB,GMRCWARD,GMRCDOB,DIC,X,Y,VA,VAIN,VAINDT,VADM,VAEL,VAPA,VAERR,GMRCSN,GMRC0,GMRC1,GMRC2