Routine: GMRGUT3

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

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

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

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

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

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

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

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

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)=""

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)

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

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

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

GMRGUT3.m