source: FOIAVistA/trunk/r/GEN_MED_REC_GENERATOR-GMRG/GMRGUT3.m@ 1582

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