- GMRGUT3 ;CISC/RM-UTILITIES ROUTINE FOR GMRG FILES (CONT.) ;5/28/92
- ;;3.0;Text Generator;;Jan 24, 1996
- EN1 ; ENTRY FROM IDENTIFIER NODE FOR PARENT
- S:$D(DX)#2 GMR("DX")=DX S:$D(DY)#2 GMR("DY")=DY S GMR("SPC")=5,GMR("LEVEL")=0,GMR("%")=$S($D(IOSL):IOSL-5,1:19),GMR("OUT")=0 D RECUR1
- I GMR("OUT") S DX=$S($X'>80:$X,1:80),DY=$S('$D(DZ):0,DZ'?1"?".E:0,1:GMR("%")+5) X ^%ZOSF("XY")
- S:$D(GMR("DX")) DX=GMR("DX") S:$D(GMR("DY")) DY=GMR("DY") K GMR W @("$E("_DIC_"Y,0),0)")
- Q
- RECUR1 ;
- S GMR("DATA")=$S($D(^GMRD(124.2,+Y,0)):^(0),1:"") W !?GMR("SPC")," ",$S($P(GMR("DATA"),U,2)="":"",$P(GMR("DATA"),U,2)=2:"FRAME",1:"TERM")
- W ?(GMR("SPC")+8)," ",$P(GMR("DATA"),U,3)
- W ?(GMR("SPC")+16)," ",$S($D(^GMRD(124.25,+$P(GMR("DATA"),U,4),0)):$P(^(0),"^"),1:"")
- D:$Y>GMR("%") EOP Q:GMR("OUT")
- D E2 Q:GMR("OUT") S GMR("SPC")=GMR("SPC")-11
- Q
- EOP ;
- S DX=$S($X'>80:$X,1:80),DY=0,$P(GMR("%"),"^",2)=1 X ^%ZOSF("XY") W !?3,"Type an '^' to stop the parent list for this term: " R GMR("^"):DTIME I GMR("^")="^"!(GMR("^")="^^")!'$T S GMR("OUT")=1 Q
- Q
- E2 ;
- F GMR(GMR("LEVEL"))=0:0 S GMR(GMR("LEVEL"))=$O(^GMRD(124.2,"AKID",+Y,GMR(GMR("LEVEL")))) Q:GMR(GMR("LEVEL"))'>0!GMR("OUT") I $D(^(GMR(GMR("LEVEL")),0)) D CWR Q:GMR("OUT")
- Q
- CWR ;
- S GMR("L")=$O(^GMRD(124.2,GMR(GMR("LEVEL")),1,"B",+Y,0)) D:$S(GMR("L")'>0:0,'$D(^GMRD(124.2,GMR(GMR("LEVEL")),1,GMR("L"),0)):0,'$P(^(0),"^",6):1,1:0) WRTID
- Q
- WRTID ;
- W ! W:'$D(GMR("FL",GMR("LEVEL"))) ?(GMR("SPC")+3),"PARENT: " W:$D(^GMRD(124.2,GMR(GMR("LEVEL")),0)) ?(GMR("SPC")+11),$P(^GMRD(124.2,GMR(GMR("LEVEL")),0),U) S GMR("FL",GMR("LEVEL"))=1
- D:$Y>GMR("%") EOP Q:GMR("OUT")
- D RECUR Q:GMR("OUT")
- Q
- RECUR ;
- Q:$D(GMR("RECURSION")) S GMR("RECURSION")=1,GMR("Y")=Y,Y=GMR(GMR("LEVEL")),GMR("LEVEL")=1 S GMR("X")=""
- S GMR("SPC")=GMR("SPC")+11 D RECUR1
- K GMR("RECURSION"),GMR("FL",GMR("LEVEL")) S Y=GMR("Y"),GMR("LEVEL")=0
- Q
- EN2 ; ENTRY FROM THE INPUT TRANSFORMS ON THE ADDITIONAL TEXT (#1) AND
- ; ASSOCIATED LEAD FRAME DATA (#2) FIELDS OF THE SELECTION MULTIPLE (#1)
- ; OF THE GMR TEXT (#124.3) FILE. TRANSFORM DISALLOWS ENTRY OF A
- ; SELECTION IF ITS PARENT IS FLAGGED AS DELETED.
- S GMRGND(0)=$P(^GMR(124.3,DA(1),1,DA,0),"^"),GMRGND(1)=DA(1),GMRGND(4)=$S($D(^GMR(124.3,DA(1),0)):$P(^(0),U),1:"")
- EN2A S GMRGSTAT="" F GMRGND(3)=0:0 S GMRGND(3)=$O(^GMRD(124.2,"AKID",GMRGND(0),GMRGND(3))) Q:GMRGND(3)'>0 S GMRGST=$O(^GMR(124.3,GMRGND(1),1,"B",GMRGND(3),0)),GMRGST(1)=GMRGND(1) I GMRGST>0 D STAT^GMRGRUT0 Q:$P(GMRGSTAT,"^",3)
- G:$P(GMRGSTAT,"^",3)!$D(^GMRD(124.2,"AKID",GMRGND(0),GMRGND(4))) Q2
- W $C(7),!!,"PARENT PREVIOUSLY DELETED. PLEASE RE-CREATE PARENT ENTRY FIRST. " K X
- Q2 K GMRGND,GMRGSTAT
- Q
- EN3 ; ENTRY FROM THE INPUT TRANSFORM ON THE MODIFICATION FIELD (#1) OF THE
- ; AUDIT TRAIL MULTIPLE (#3) OF THE SELECTION SUBFIELD (#1) OF THE GMR
- ; TEXT (#124.3) FILE. TRANSFORMS DISALLOWS ENTRY OF AND AUDIT IF ITS
- ; SELECTION'S PARENT HAS BEEN FLAGGED AS DELETED.
- S GMRGND(0)=$P(^GMR(124.3,DA(2),1,DA(1),0),"^"),GMRGND(1)=DA(2),GMRGND(4)=$S($D(^GMR(124.3,DA(2),0)):$P(^(0),U),1:"") D EN2A
- Q3 Q
- DEL5 ;KILL LOGIC
- F GMRG(1)=0:0 S GMRG(1)=$O(^DD(124.21,GMRG(3),1,GMRG(1))) Q:GMRG(1)'>0 X:$D(^DD(124.21,GMRG(3),1,GMRG(1),2)) ^(2)
- S $P(^GMRD(124.2,DA(1),1,DA,0),"^",GMRG(3)+1)=""
- Q
- SET5 ;SET LOGIC
- S $P(^GMRD(124.2,DA(1),1,DA,0),"^",GMRG(3)+1)=X
- F GMRG(1)=0:0 S GMRG(1)=$O(^DD(124.21,GMRG(3),1,GMRG(1))) Q:GMRG(1)'>0 X:$D(^DD(124.21,GMRG(3),1,GMRG(1),1)) ^(1)
- Q
- EN4 ; ENTRY FROM THE C XREF OF THE .01 FIELD OF THE 124.2 FILE SET LOGIC
- D UPCS
- S ^GMRD(124.2,"C",GMRGUPX,DA)=""
- K GMRGUPX
- Q
- EN5 ; ENTRY FROM THE C XREF OF THE .01 FIELD OF THE 124.2 FILE KILL LOGIC
- D UPCS
- K ^GMRD(124.2,"C",GMRGUPX,DA)
- K GMRUPX
- Q
- UPCS ;
- S GMRGUPX=X F GMRGUPX(0)=1:1:$L(X) I $E(X,GMRGUPX(0))?1L S GMRGUPX=$E(GMRGUPX,1,GMRGUPX(0)-1)_$C($A($E(X,GMRGUPX(0)))-32)_$E(GMRGUPX,GMRGUPX(0)+1,$L(X))
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRGUT3 3901 printed Feb 18, 2025@23:22:06 Page 2
- GMRGUT3 ;CISC/RM-UTILITIES ROUTINE FOR GMRG FILES (CONT.) ;5/28/92
- +1 ;;3.0;Text Generator;;Jan 24, 1996
- EN1 ; ENTRY FROM IDENTIFIER NODE FOR PARENT
- +1 if $DATA(DX)#2
- SET GMR("DX")=DX
- if $DATA(DY)#2
- SET GMR("DY")=DY
- SET GMR("SPC")=5
- SET GMR("LEVEL")=0
- SET GMR("%")=$SELECT($DATA(IOSL):IOSL-5,1:19)
- SET GMR("OUT")=0
- DO RECUR1
- +2 IF GMR("OUT")
- SET DX=$SELECT($X'>80:$X,1:80)
- SET DY=$SELECT('$DATA(DZ):0,DZ'?1"?".E:0,1:GMR("%")+5)
- XECUTE ^%ZOSF("XY")
- +3 if $DATA(GMR("DX"))
- SET DX=GMR("DX")
- if $DATA(GMR("DY"))
- SET DY=GMR("DY")
- KILL GMR
- WRITE @("$E("_DIC_"Y,0),0)")
- +4 QUIT
- RECUR1 ;
- +1 SET GMR("DATA")=$SELECT($DATA(^GMRD(124.2,+Y,0)):^(0),1:"")
- WRITE !?GMR("SPC")," ",$SELECT($PIECE(GMR("DATA"),U,2)="":"",$PIECE(GMR("DATA"),U,2)=2:"FRAME",1:"TERM")
- +2 WRITE ?(GMR("SPC")+8)," ",$PIECE(GMR("DATA"),U,3)
- +3 WRITE ?(GMR("SPC")+16)," ",$SELECT($DATA(^GMRD(124.25,+$PIECE(GMR("DATA"),U,4),0)):$PIECE(^(0),"^"),1:"")
- +4 if $Y>GMR("%")
- DO EOP
- if GMR("OUT")
- QUIT
- +5 DO E2
- if GMR("OUT")
- QUIT
- SET GMR("SPC")=GMR("SPC")-11
- +6 QUIT
- EOP ;
- +1 SET DX=$SELECT($X'>80:$X,1:80)
- SET DY=0
- SET $PIECE(GMR("%"),"^",2)=1
- XECUTE ^%ZOSF("XY")
- WRITE !?3,"Type an '^' to stop the parent list for this term: "
- READ GMR("^"):DTIME
- IF GMR("^")="^"!(GMR("^")="^^")!'$TEST
- SET GMR("OUT")=1
- QUIT
- +2 QUIT
- E2 ;
- +1 FOR GMR(GMR("LEVEL"))=0:0
- SET GMR(GMR("LEVEL"))=$ORDER(^GMRD(124.2,"AKID",+Y,GMR(GMR("LEVEL"))))
- if GMR(GMR("LEVEL"))'>0!GMR("OUT")
- QUIT
- IF $DATA(^(GMR(GMR("LEVEL")),0))
- DO CWR
- if GMR("OUT")
- QUIT
- +2 QUIT
- CWR ;
- +1 SET GMR("L")=$ORDER(^GMRD(124.2,GMR(GMR("LEVEL")),1,"B",+Y,0))
- if $SELECT(GMR("L")'>0
- DO WRTID
- +2 QUIT
- WRTID ;
- +1 WRITE !
- if '$DATA(GMR("FL",GMR("LEVEL")))
- WRITE ?(GMR("SPC")+3),"PARENT: "
- if $DATA(^GMRD(124.2,GMR(GMR("LEVEL")),0))
- WRITE ?(GMR("SPC")+11),$PIECE(^GMRD(124.2,GMR(GMR("LEVEL")),0),U)
- SET GMR("FL",GMR("LEVEL"))=1
- +2 if $Y>GMR("%")
- DO EOP
- if GMR("OUT")
- QUIT
- +3 DO RECUR
- if GMR("OUT")
- QUIT
- +4 QUIT
- RECUR ;
- +1 if $DATA(GMR("RECURSION"))
- QUIT
- SET GMR("RECURSION")=1
- SET GMR("Y")=Y
- SET Y=GMR(GMR("LEVEL"))
- SET GMR("LEVEL")=1
- SET GMR("X")=""
- +2 SET GMR("SPC")=GMR("SPC")+11
- DO RECUR1
- +3 KILL GMR("RECURSION"),GMR("FL",GMR("LEVEL"))
- SET Y=GMR("Y")
- SET GMR("LEVEL")=0
- +4 QUIT
- EN2 ; ENTRY FROM THE INPUT TRANSFORMS ON THE ADDITIONAL TEXT (#1) AND
- +1 ; ASSOCIATED LEAD FRAME DATA (#2) FIELDS OF THE SELECTION MULTIPLE (#1)
- +2 ; OF THE GMR TEXT (#124.3) FILE. TRANSFORM DISALLOWS ENTRY OF A
- +3 ; SELECTION IF ITS PARENT IS FLAGGED AS DELETED.
- +4 SET GMRGND(0)=$PIECE(^GMR(124.3,DA(1),1,DA,0),"^")
- SET GMRGND(1)=DA(1)
- SET GMRGND(4)=$SELECT($DATA(^GMR(124.3,DA(1),0)):$PIECE(^(0),U),1:"")
- EN2A SET GMRGSTAT=""
- FOR GMRGND(3)=0:0
- SET GMRGND(3)=$ORDER(^GMRD(124.2,"AKID",GMRGND(0),GMRGND(3)))
- if GMRGND(3)'>0
- QUIT
- SET GMRGST=$ORDER(^GMR(124.3,GMRGND(1),1,"B",GMRGND(3),0))
- SET GMRGST(1)=GMRGND(1)
- IF GMRGST>0
- DO STAT^GMRGRUT0
- if $PIECE(GMRGSTAT,"^",3)
- QUIT
- +1 if $PIECE(GMRGSTAT,"^",3)!$DATA(^GMRD(124.2,"AKID",GMRGND(0),GMRGND(4)))
- GOTO Q2
- +2 WRITE $CHAR(7),!!,"PARENT PREVIOUSLY DELETED. PLEASE RE-CREATE PARENT ENTRY FIRST. "
- KILL X
- Q2 KILL GMRGND,GMRGSTAT
- +1 QUIT
- EN3 ; ENTRY FROM THE INPUT TRANSFORM ON THE MODIFICATION FIELD (#1) OF THE
- +1 ; AUDIT TRAIL MULTIPLE (#3) OF THE SELECTION SUBFIELD (#1) OF THE GMR
- +2 ; TEXT (#124.3) FILE. TRANSFORMS DISALLOWS ENTRY OF AND AUDIT IF ITS
- +3 ; SELECTION'S PARENT HAS BEEN FLAGGED AS DELETED.
- +4 SET GMRGND(0)=$PIECE(^GMR(124.3,DA(2),1,DA(1),0),"^")
- SET GMRGND(1)=DA(2)
- SET GMRGND(4)=$SELECT($DATA(^GMR(124.3,DA(2),0)):$PIECE(^(0),U),1:"")
- DO EN2A
- Q3 QUIT
- DEL5 ;KILL LOGIC
- +1 FOR GMRG(1)=0:0
- SET GMRG(1)=$ORDER(^DD(124.21,GMRG(3),1,GMRG(1)))
- if GMRG(1)'>0
- QUIT
- if $DATA(^DD(124.21,GMRG(3),1,GMRG(1),2))
- XECUTE ^(2)
- +2 SET $PIECE(^GMRD(124.2,DA(1),1,DA,0),"^",GMRG(3)+1)=""
- +3 QUIT
- SET5 ;SET LOGIC
- +1 SET $PIECE(^GMRD(124.2,DA(1),1,DA,0),"^",GMRG(3)+1)=X
- +2 FOR GMRG(1)=0:0
- SET GMRG(1)=$ORDER(^DD(124.21,GMRG(3),1,GMRG(1)))
- if GMRG(1)'>0
- QUIT
- if $DATA(^DD(124.21,GMRG(3),1,GMRG(1),1))
- XECUTE ^(1)
- +3 QUIT
- EN4 ; ENTRY FROM THE C XREF OF THE .01 FIELD OF THE 124.2 FILE SET LOGIC
- +1 DO UPCS
- +2 SET ^GMRD(124.2,"C",GMRGUPX,DA)=""
- +3 KILL GMRGUPX
- +4 QUIT
- EN5 ; ENTRY FROM THE C XREF OF THE .01 FIELD OF THE 124.2 FILE KILL LOGIC
- +1 DO UPCS
- +2 KILL ^GMRD(124.2,"C",GMRGUPX,DA)
- +3 KILL GMRUPX
- +4 QUIT
- UPCS ;
- +1 SET GMRGUPX=X
- FOR GMRGUPX(0)=1:1:$LENGTH(X)
- IF $EXTRACT(X,GMRGUPX(0))?1L
- SET GMRGUPX=$EXTRACT(GMRGUPX,1,GMRGUPX(0)-1)_$CHAR($ASCII($EXTRACT(X,GMRGUPX(0)))-32)_$EXTRACT(GMRGUPX,GMRGUPX(0)+1,$LENGTH(X))
- +2 QUIT