GMRGUT2 ;CISC/RM-DATA DICTIONARY UTILITIES (cont.) ;5/28/92
;;3.0;Text Generator;;Jan 24, 1996
EN1 ; ENTRY FROM THE SET LOGIC OF THE ATD XREF ON CLASSIFICATION FIELD
; (#.04) OF THE AGGREGATE TERM (#124.2) FILE
S GMRG(0)=$S($D(^GMRD(124.2,DA,0)):^(0),1:""),GMRG(0)=$S(GMRG=.03:X_"^"_$P(GMRG(0),"^",4),GMRG=.04:$P(GMRG(0),"^",3)_"^"_X,1:$P(GMRG(0),"^",3,4)),GMRG=$S($D(^GMRD(124.25,+$P(GMRG(0),"^",2),0)):$P(^(0),U,3),1:"") G:'GMRG A1
I $P(GMRG(0),"^")'="",$P(GMRG(0),"^",2)'="" S ^GMRD(124.2,"ATD",$P(GMRG(0),"^"),$P(GMRG(0),"^",2),DA)=""
A1 F GMRG=7:1:10 I $D(^GMRD(124.25,+X,GMRG)) D DL12,ST12
K GMRG,GMRGPRM
Q
DL12 ;
S GMRG("X")=X,X=$S($D(^GMRD(124.2,DA,GMRG)):^(GMRG),1:"") F GMRG(0)=0:0 S GMRG(0)=$O(^DD(124.2,GMRG,1,GMRG(0))) Q:GMRG(0)'>0 X:$D(^DD(124.2,GMRG,1,GMRG(0),2)) ^(2)
S X=GMRG("X"),^GMRD(124.2,DA,GMRG)=""
Q
ST12 ;
S GMRG("X")=X,X=$S($D(^GMRD(124.25,+X,GMRG)):^(GMRG),1:""),^GMRD(124.2,DA,GMRG)=X I X'="" F GMRG(0)=0:0 S GMRG(0)=$O(^DD(124.2,GMRG,1,GMRG(0))) Q:GMRG(0)'>0 X:$D(^DD(124.2,GMRG,1,GMRG(0),1)) ^(1)
S X=GMRG("X")
Q
EN2 ; ENTRY FROM KILL LOGIC ON ATD XREF OF CLASSIFICATION FIELD (#.04)
; OF THE AGGREGATE TERM (#124.2) FILE
S GMRG(0)=$S($D(^GMRD(124.2,DA,0)):^(0),1:""),GMRG(0)=$S(GMRG=.03:X_"^"_$P(GMRG(0),"^",4),GMRG=.04:$P(GMRG(0),"^",3)_"^"_X,1:$P(GMRG(0),"^",3,4)),GMRG=$S($D(^GMRD(124.25,+$P(GMRG(0),"^",2),0)):$P(^(0),U,3),1:"") G A2:'GMRG&'$D(GMRGX("DEL"))
I $P(GMRG(0),"^")'="",$P(GMRG(0),"^",2)'="" K ^GMRD(124.2,"ATD",$P(GMRG(0),"^"),$P(GMRG(0),"^",2),DA)
A2 F GMRG=7:1:10 I $D(^GMRD(124.25,+X,GMRG)) D DL12
K GMRG,GMRGPRM
Q
EN3 ; ENTRY FROM SET LOGIC ON ATD XREF OF BEGIN TEXT (#2) FIELD OF THE
; GMR TERM CLASSIFICATION (#124.25) FILE
S GMRGX("X")=X,GMRGX("DA")=DA,X=DA F DA=0:0 S DA=$O(^GMRD(124.2,"CL",X,DA)) Q:DA'>0 W "." S GMRG=.04 D EN1
S X=GMRGX("X"),DA=GMRGX("DA")
K GMRGX
Q
EN4 ; ENTRY FROM KILL LOGIC ON ATD XREF OF BEGIN TEXT (#2) FIELD OF THE
; GMR TERM CLASSIFICATION (#124.25) FILE.
S GMRGX("X")=X,GMRGX("DA")=DA,X=DA,GMRGX("DEL")=1 F DA=0:0 S DA=$O(^GMRD(124.2,"CL",X,DA)) Q:DA'>0 W "." S GMRG=.04 D EN2
S X=GMRGX("X"),DA=GMRGX("DA") K GMRGX
Q
EN5 ;ENTRY TO SET & KILL XREF FROM ACHTXT^MUMPS XREF ON .01 SUB
;SUB FIELD OF CHILDREN (#1 FIELD) OF THE 124.2 FILE
Q:$D(GMRGXVER) S GMRG=$S($D(^GMRD(124.2,X,0)):^(0),1:""),GMRG("X")=X
F GMRG(2)=1:1:3,5 S X=$P(GMRG,"^",GMRG(2)),GMRG(3)=$S(GMRG(2)'=5:GMRG(2),1:4) D PRC5
S X=GMRG("X")
K GMRG
Q
PRC5 ;
I GMRG(0)=0,X'="" D DEL5^GMRGUT3
I GMRG(0)=1,X'="" D SET5^GMRGUT3
Q
EN6 ;ENTRY FROM ATXTUP XREF ON THE TERM FIELD (#.01) , ATYUP XREF OF
; THE TYPE OF TERM (.02) FIELD, THE APKUP XREF OF THE PACKAGE (.03)
; FIELD, AND THE ANDUP OF THE NODE IDENTIFICATION (.05) FIELD OF THE
; GMR AGGREGATE TERM (#124.2) FILE.
Q:$D(GMRGXVER) S GMRGX("ODA1")=$S($D(DA(1)):DA(1),1:"@"),GMRGX("ODA")=DA
F DA(1)=0:0 S DA(1)=$O(^GMRD(124.2,"AKID",GMRGX("ODA"),DA(1))) Q:DA(1)'>0 F GMRGX(1)=0,1 F DA=0:0 S DA=$O(^GMRD(124.2,"AKID",GMRGX("ODA"),DA(1),GMRGX(1),DA)) Q:DA'>0 D S6
K DA S DA=GMRGX("ODA") S:GMRGX("ODA1")'="@" DA(1)=GMRGX("ODA1") K GMRGX
Q
S6 I GMRGX("D") S $P(^GMRD(124.2,DA(1),1,DA,0),U,GMRGX("F")+1)=X F GMRGX=0:0 S GMRGX=$O(^DD(124.21,GMRGX("F"),1,GMRGX)) Q:GMRGX'>0 X:$D(^DD(124.21,GMRGX("F"),1,GMRGX,1)) ^(1)
I 'GMRGX("D") F GMRGX=0:0 S GMRGX=$O(^DD(124.21,GMRGX("F"),1,GMRGX)) Q:GMRGX'>0 X:$D(^DD(124.21,GMRGX("F"),1,GMRGX,2)) ^(2)
I 'GMRGX("D") S $P(^GMRD(124.2,DA(1),1,DA,0),U,GMRGX("F")+1)=""
Q
EN7 ; OLD XREF CALLED HERE. THIS ENTRY RETAINED FOR BACKWARD COMP.
G EN7^GMRGUT4
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRGUT2 3594 printed Nov 22, 2024@17:05:52 Page 2
GMRGUT2 ;CISC/RM-DATA DICTIONARY UTILITIES (cont.) ;5/28/92
+1 ;;3.0;Text Generator;;Jan 24, 1996
EN1 ; ENTRY FROM THE SET LOGIC OF THE ATD XREF ON CLASSIFICATION FIELD
+1 ; (#.04) OF THE AGGREGATE TERM (#124.2) FILE
+2 SET GMRG(0)=$SELECT($DATA(^GMRD(124.2,DA,0)):^(0),1:"")
SET GMRG(0)=$SELECT(GMRG=.03:X_"^"_$PIECE(GMRG(0),"^",4),GMRG=.04:$PIECE(GMRG(0),"^",3)_"^"_X,1:$PIECE(GMRG(0),"^",3,4))
SET GMRG=$SELECT($DATA(^GMRD(124.25,+$PIECE(GMRG(0),"^",2),0)):$PIECE(^(0),U,3),1:"")
if 'GMRG
GOTO A1
+3 IF $PIECE(GMRG(0),"^")'=""
IF $PIECE(GMRG(0),"^",2)'=""
SET ^GMRD(124.2,"ATD",$PIECE(GMRG(0),"^"),$PIECE(GMRG(0),"^",2),DA)=""
A1 FOR GMRG=7:1:10
IF $DATA(^GMRD(124.25,+X,GMRG))
DO DL12
DO ST12
+1 KILL GMRG,GMRGPRM
+2 QUIT
DL12 ;
+1 SET GMRG("X")=X
SET X=$SELECT($DATA(^GMRD(124.2,DA,GMRG)):^(GMRG),1:"")
FOR GMRG(0)=0:0
SET GMRG(0)=$ORDER(^DD(124.2,GMRG,1,GMRG(0)))
if GMRG(0)'>0
QUIT
if $DATA(^DD(124.2,GMRG,1,GMRG(0),2))
XECUTE ^(2)
+2 SET X=GMRG("X")
SET ^GMRD(124.2,DA,GMRG)=""
+3 QUIT
ST12 ;
+1 SET GMRG("X")=X
SET X=$SELECT($DATA(^GMRD(124.25,+X,GMRG)):^(GMRG),1:"")
SET ^GMRD(124.2,DA,GMRG)=X
IF X'=""
FOR GMRG(0)=0:0
SET GMRG(0)=$ORDER(^DD(124.2,GMRG,1,GMRG(0)))
if GMRG(0)'>0
QUIT
if $DATA(^DD(124.2,GMRG,1,GMRG(0),1))
XECUTE ^(1)
+2 SET X=GMRG("X")
+3 QUIT
EN2 ; ENTRY FROM KILL LOGIC ON ATD XREF OF CLASSIFICATION FIELD (#.04)
+1 ; OF THE AGGREGATE TERM (#124.2) FILE
+2 SET GMRG(0)=$SELECT($DATA(^GMRD(124.2,DA,0)):^(0),1:"")
SET GMRG(0)=$SELECT(GMRG=.03:X_"^"_$PIECE(GMRG(0),"^",4),GMRG=.04:$PIECE(GMRG(0),"^",3)_"^"_X,1:$PIECE(GMRG(0),"^",3,4))
SET GMRG=$SELECT($DATA(^GMRD(124.25,+$PIECE(GMRG(0),"^",2),0)):$PIECE(^(0),U,3),1:"")
if 'GMRG&'$DATA(GMRGX("DEL"))
GOTO A2
+3 IF $PIECE(GMRG(0),"^")'=""
IF $PIECE(GMRG(0),"^",2)'=""
KILL ^GMRD(124.2,"ATD",$PIECE(GMRG(0),"^"),$PIECE(GMRG(0),"^",2),DA)
A2 FOR GMRG=7:1:10
IF $DATA(^GMRD(124.25,+X,GMRG))
DO DL12
+1 KILL GMRG,GMRGPRM
+2 QUIT
EN3 ; ENTRY FROM SET LOGIC ON ATD XREF OF BEGIN TEXT (#2) FIELD OF THE
+1 ; GMR TERM CLASSIFICATION (#124.25) FILE
+2 SET GMRGX("X")=X
SET GMRGX("DA")=DA
SET X=DA
FOR DA=0:0
SET DA=$ORDER(^GMRD(124.2,"CL",X,DA))
if DA'>0
QUIT
WRITE "."
SET GMRG=.04
DO EN1
+3 SET X=GMRGX("X")
SET DA=GMRGX("DA")
+4 KILL GMRGX
+5 QUIT
EN4 ; ENTRY FROM KILL LOGIC ON ATD XREF OF BEGIN TEXT (#2) FIELD OF THE
+1 ; GMR TERM CLASSIFICATION (#124.25) FILE.
+2 SET GMRGX("X")=X
SET GMRGX("DA")=DA
SET X=DA
SET GMRGX("DEL")=1
FOR DA=0:0
SET DA=$ORDER(^GMRD(124.2,"CL",X,DA))
if DA'>0
QUIT
WRITE "."
SET GMRG=.04
DO EN2
+3 SET X=GMRGX("X")
SET DA=GMRGX("DA")
KILL GMRGX
+4 QUIT
EN5 ;ENTRY TO SET & KILL XREF FROM ACHTXT^MUMPS XREF ON .01 SUB
+1 ;SUB FIELD OF CHILDREN (#1 FIELD) OF THE 124.2 FILE
+2 if $DATA(GMRGXVER)
QUIT
SET GMRG=$SELECT($DATA(^GMRD(124.2,X,0)):^(0),1:"")
SET GMRG("X")=X
+3 FOR GMRG(2)=1:1:3,5
SET X=$PIECE(GMRG,"^",GMRG(2))
SET GMRG(3)=$SELECT(GMRG(2)'=5:GMRG(2),1:4)
DO PRC5
+4 SET X=GMRG("X")
+5 KILL GMRG
+6 QUIT
PRC5 ;
+1 IF GMRG(0)=0
IF X'=""
DO DEL5^GMRGUT3
+2 IF GMRG(0)=1
IF X'=""
DO SET5^GMRGUT3
+3 QUIT
EN6 ;ENTRY FROM ATXTUP XREF ON THE TERM FIELD (#.01) , ATYUP XREF OF
+1 ; THE TYPE OF TERM (.02) FIELD, THE APKUP XREF OF THE PACKAGE (.03)
+2 ; FIELD, AND THE ANDUP OF THE NODE IDENTIFICATION (.05) FIELD OF THE
+3 ; GMR AGGREGATE TERM (#124.2) FILE.
+4 if $DATA(GMRGXVER)
QUIT
SET GMRGX("ODA1")=$SELECT($DATA(DA(1)):DA(1),1:"@")
SET GMRGX("ODA")=DA
+5 FOR DA(1)=0:0
SET DA(1)=$ORDER(^GMRD(124.2,"AKID",GMRGX("ODA"),DA(1)))
if DA(1)'>0
QUIT
FOR GMRGX(1)=0,1
FOR DA=0:0
SET DA=$ORDER(^GMRD(124.2,"AKID",GMRGX("ODA"),DA(1),GMRGX(1),DA))
if DA'>0
QUIT
DO S6
+6 KILL DA
SET DA=GMRGX("ODA")
if GMRGX("ODA1")'="@"
SET DA(1)=GMRGX("ODA1")
KILL GMRGX
+7 QUIT
S6 IF GMRGX("D")
SET $PIECE(^GMRD(124.2,DA(1),1,DA,0),U,GMRGX("F")+1)=X
FOR GMRGX=0:0
SET GMRGX=$ORDER(^DD(124.21,GMRGX("F"),1,GMRGX))
if GMRGX'>0
QUIT
if $DATA(^DD(124.21,GMRGX("F"),1,GMRGX,1))
XECUTE ^(1)
+1 IF 'GMRGX("D")
FOR GMRGX=0:0
SET GMRGX=$ORDER(^DD(124.21,GMRGX("F"),1,GMRGX))
if GMRGX'>0
QUIT
if $DATA(^DD(124.21,GMRGX("F"),1,GMRGX,2))
XECUTE ^(2)
+2 IF 'GMRGX("D")
SET $PIECE(^GMRD(124.2,DA(1),1,DA,0),U,GMRGX("F")+1)=""
+3 QUIT
EN7 ; OLD XREF CALLED HERE. THIS ENTRY RETAINED FOR BACKWARD COMP.
+1 GOTO EN7^GMRGUT4
+2 QUIT
