71 lines
3.7 KiB
Mathematica
71 lines
3.7 KiB
Mathematica
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
|