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

Last change on this file since 1535 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 3.7 KB
Line 
1GMRGUT3 ;CISC/RM-UTILITIES ROUTINE FOR GMRG FILES (CONT.) ;5/28/92
2 ;;3.0;Text Generator;;Jan 24, 1996
3EN1 ; ENTRY FROM IDENTIFIER NODE FOR PARENT
4 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
5 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")
6 S:$D(GMR("DX")) DX=GMR("DX") S:$D(GMR("DY")) DY=GMR("DY") K GMR W @("$E("_DIC_"Y,0),0)")
7 Q
8RECUR1 ;
9 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")
10 W ?(GMR("SPC")+8)," ",$P(GMR("DATA"),U,3)
11 W ?(GMR("SPC")+16)," ",$S($D(^GMRD(124.25,+$P(GMR("DATA"),U,4),0)):$P(^(0),"^"),1:"")
12 D:$Y>GMR("%") EOP Q:GMR("OUT")
13 D E2 Q:GMR("OUT") S GMR("SPC")=GMR("SPC")-11
14 Q
15EOP ;
16 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
17 Q
18E2 ;
19 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")
20 Q
21CWR ;
22 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
23 Q
24WRTID ;
25 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
26 D:$Y>GMR("%") EOP Q:GMR("OUT")
27 D RECUR Q:GMR("OUT")
28 Q
29RECUR ;
30 Q:$D(GMR("RECURSION")) S GMR("RECURSION")=1,GMR("Y")=Y,Y=GMR(GMR("LEVEL")),GMR("LEVEL")=1 S GMR("X")=""
31 S GMR("SPC")=GMR("SPC")+11 D RECUR1
32 K GMR("RECURSION"),GMR("FL",GMR("LEVEL")) S Y=GMR("Y"),GMR("LEVEL")=0
33 Q
34EN2 ; ENTRY FROM THE INPUT TRANSFORMS ON THE ADDITIONAL TEXT (#1) AND
35 ; ASSOCIATED LEAD FRAME DATA (#2) FIELDS OF THE SELECTION MULTIPLE (#1)
36 ; OF THE GMR TEXT (#124.3) FILE. TRANSFORM DISALLOWS ENTRY OF A
37 ; SELECTION IF ITS PARENT IS FLAGGED AS DELETED.
38 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:"")
39EN2A 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)
40 G:$P(GMRGSTAT,"^",3)!$D(^GMRD(124.2,"AKID",GMRGND(0),GMRGND(4))) Q2
41 W $C(7),!!,"PARENT PREVIOUSLY DELETED. PLEASE RE-CREATE PARENT ENTRY FIRST. " K X
42Q2 K GMRGND,GMRGSTAT
43 Q
44EN3 ; ENTRY FROM THE INPUT TRANSFORM ON THE MODIFICATION FIELD (#1) OF THE
45 ; AUDIT TRAIL MULTIPLE (#3) OF THE SELECTION SUBFIELD (#1) OF THE GMR
46 ; TEXT (#124.3) FILE. TRANSFORMS DISALLOWS ENTRY OF AND AUDIT IF ITS
47 ; SELECTION'S PARENT HAS BEEN FLAGGED AS DELETED.
48 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
49Q3 Q
50DEL5 ;KILL LOGIC
51 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)
52 S $P(^GMRD(124.2,DA(1),1,DA,0),"^",GMRG(3)+1)=""
53 Q
54SET5 ;SET LOGIC
55 S $P(^GMRD(124.2,DA(1),1,DA,0),"^",GMRG(3)+1)=X
56 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)
57 Q
58EN4 ; ENTRY FROM THE C XREF OF THE .01 FIELD OF THE 124.2 FILE SET LOGIC
59 D UPCS
60 S ^GMRD(124.2,"C",GMRGUPX,DA)=""
61 K GMRGUPX
62 Q
63EN5 ; ENTRY FROM THE C XREF OF THE .01 FIELD OF THE 124.2 FILE KILL LOGIC
64 D UPCS
65 K ^GMRD(124.2,"C",GMRGUPX,DA)
66 K GMRUPX
67 Q
68UPCS ;
69 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))
70 Q
Note: See TracBrowser for help on using the repository browser.