- 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 Mar 13, 2025@20:51:42 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
