- 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
- 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
