source: IHS-VA_UTILITIES-XB/trunk/XBDHDF.m@ 1562

Last change on this file since 1562 was 642, checked in by Sam Habiel, 15 years ago

Modified directory structure; moved routines.

File size: 3.5 KB
Line 
1XBDHDF ; IHS/ADC/GTH - GETS FIELD INFO FOR HEADER LINE EDITOR ; [ 02/07/97 3:02 PM ]
2 ;;4.0;XB;;Jul 20, 2009;Build 2
3 ;
4NEW ;
5 NEW XBDHXX,XBDHQUIT
6VAR ;
7 S X=^TMP("XBDH",$J,"STACK",XBDHLIFO),XBDHDFN=$P(X,U),XBDHDFNA=$P(X,U,2),XBDHDSUB=$P(X,U,3),XBDHDPTH=$P(X,U,4)
8 KILL X
9 I $D(XBDHMFLG) KILL XBDHMFLG S Y="" G OK1
10MORE ;
11 D PATH
12GETFIELD ;
13 S Z=$J("",(XBDHLIFO*2)-2)_$S(XBDHCHN=1:"First",1:"Then")_" print "_$S(XBDHLIFO>1:(XBDHDFNA_" "),1:"")_XBDHDSUB_"field"
14 S A=""
15 I $D(XBDHMULT) S A=XBDHMULT,XBDHMFLG="" KILL XBDHMULT
16 S Z=Z_": "
17 I A]"" S Z=Z_A_"//"
18 W !,Z
19 R Y:DTIME
20 E S Y=U
21 I Y="" S Y=A
22 I Y="?" W !!,"Enter field name,number,computed expr.,MUMPS code,jump syntax or '??' for list",!! G GETFIELD
23 I Y="^" W !! Q
24 I Y="",XBDHCHN=1 W ! G GETFIELD
25 I Y="",XBDHLIFO=1 W !! Q
26OK1 ;
27 I Y="" KILL ^TMP("XBDH",$J,"STACK",XBDHLIFO) S XBDHLIFO=XBDHLIFO-1,XBDHDPTH=$P(XBDHDPTH,";",1,XBDHLIFO)_";" W !!! G VAR
28 I Y?1"."1U,$E(Y,2)']$C(63+XBDHCHN) S XBDHECHN=($A($E(Y,2))-64) Q
29 S XBDHXX=Y
30 I $E(Y,$L(Y))=":" D ^XBDHDF1 G VAR:Y'=-1,OUT:A="^",GETFIELD
31 S DIC(0)="EZ",DIC="^DD(XBDHDFN,",X=Y
32 D ^DIC
33 I X="??" W !! G GETFIELD
34 I Y'=-1 D OK S X=$P(^DD(XBDHDFN,+Y,0),U,2) I X?1.9N1"."2N.E D MULTIPLE I Z="VAR" G VAR
35 I Y'=-1 Q
36CKMUMPS ;
37 D ^DIM
38 I $D(X) W !,"MUMPS EXPRESSION ENTERED",!! D MUMPS G @X
39CKM1 ;
40 S Y=XBDHXX
41 I $E(Y,$L(Y))'=":" D ^XBDHDF1 G VAR:Y'=-1,OUT:A="^"
42 D COMPUTED
43 G:$D(XBDHQUIT) OUT
44 W !
45 Q:$D(XBDHHDN)
46 G GETFIELD
47 ;
48OK ;
49 S XBDHHDNO=+Y,XBDHHDN=$P(Y,U,2)
50 Q
51 ;
52COMPUTED ;
53 I XBDHXX="NUMBER" S (XBDHHDN,XBDHHDNO)=XBDHXX KILL XBDHXX Q
54 S X=XBDHXX
55 D ^DIM
56 I $D(X) G C1
57 W !
58 S DIR(0)="YO",DIR("A")="This is a computed expression, right",DIR("B")="YES"
59 D ^DIR
60 KILL DIR
61 I Y=U W !! Q
62 I 'Y KILL Y,XBDHHDN W !,"SORRY, I DON'T UNDERSTAND THIS ENTRY...TRY AGAIN",!!,*7 Q
63C1 ;
64 S XBDHHDN="",XBDHHDNO=XBDHXX
65 KILL XBDHXX
66 Q
67 ;
68MUMPS ;
69 S %=1
70 W !,"DOES THIS MUMPS EXPRESSION REQUIRE A COLUMN HEADER"
71 D YN^DICN
72 I %Y=U S X="OUT" Q
73 I $E(%Y)'="N" W ! S X="CKM1" Q
74 F I=1:1 I '$D(^TMP("XBDH",$J,"HEADER",XBDHCHN,I)) S ^(I)=XBDHXX Q
75 S X="GETFIELD"
76 W !!!
77 Q
78 ;
79MULTIPLE ;
80 S Z=^DD(+X,.01,0)
81 I $P(Z,U,2)["W" W " (word-processing)" Q
82 W " (multiple)"
83 S Z=$O(^DD(+X,0,"NM","")),XBDHLIFO=XBDHLIFO+1,XBDHDPTH=XBDHDPTH_Z_";"
84 S ^TMP("XBDH",$J,"STACK",XBDHLIFO)=+X_U_Z_U_"SUB-"_U_XBDHDPTH
85 S Z=$O(^DD(+X,.01))
86 S:Z'=+Z XBDHMULT=$P(^DD(+X,.01,0),U)
87 W !!
88 S Z="VAR"
89 Q
90 ;
91PATH ;
92 NEW A,X,Y,Z
93 S X="CURRENTLY PRINTING FIELDS FROM THE ",A=0,Y=$L(XBDHDPTH,";")
94 I XBDHDPTH="" S X=X_"'"_XBDHPDNA_"'"_" FILE" G LINE
95DECI ;
96 S Y=Y-1
97 G:Y=0 LAST
98 S A=A+1,Z=$P(XBDHDPTH,";",Y)
99 I A>1 S X=X_"OF THE "
100 I $E(Z,$L(Z))=":" S X=X_"'"_$P(^TMP("XBDH",$J,"STACK",XBDHLIFO),U,2)_"'"_" FILE" G LINE
101 S X=X_"'"_Z_"'"_" SUB-FILE "
102 G DECI
103 ;
104LAST ;
105 I A S X=X_"OF THE "
106 S X=X_"'"_XBDHPDNA_"'"_" FILE"
107LINE ;
108 W !!,X,!!
109 Q
110 ;
111OUT ;
112 S Y="^"
113 Q
114 ;
115NOTES ;
116 ; INTERPRETS THE ANSWER TO THE "THEN ENTER FIELD: " QUERY
117 ; INPUT = ^TMP("XBDH",$J,"STACK",XBDHLIFO) [XBDHDFN^XBDHDFNA^XBDHDSUB^XBDHDPTH],XBDHCHN,XBDHLIFO
118 ; OUTPUT = XBDHHDNO,XBDHHDN
119 ; IF FIELD IS A MULTIPLE, IT RESETS PATH AND LIFO AND ASKS FOR SUBFILE. IF ONLY .01 FIELD OF SUBFILE EXISTS, IT PROMPTS FOR IT.
120 ; ANY ANSWER IT CANT FIGURE OUT IS TREATED (AT LEAST TEMPORARILY) AS A COMPUTED FIELD
121 ; IF ANSWER IS A RELATIONAL JUMP (ie ENDS IN ':') IT CHECKS ITS LEGALITY,RESETS PATH AND LIFO.
122 ; MUMPS EXPRSSIONS ARE ATTACHED TO THE SUCCEEDING FIELD AS THE SUBSCRIPT ^TMP("XBDH",$J,"HEADER",X,Y) AND WILL FOLLOW THIS FIELD IF IT IS MOVED OR REMOVED
123 ; IF USER IS IN A SUBFILE OR JUMPED-TO FILE , PRESSING <CR> WILL MOVE HIM TO THE NEXT HIGHER LEVEL
Note: See TracBrowser for help on using the repository browser.