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 ---[H[J[2J[HGMRCRA 1520 printed Nov 22, 2024@16:57:14 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
