source: IHS-VA_UTILITIES-XB/trunk/XBHEDD4.m@ 808

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

Modified directory structure; moved routines.
File size: 3.7 KB
Line 
1XBHEDD4 ;DJB,402,10/23/91,EDD - Individual Field Summary
2 ;;4.0;XB;;Jul 20, 2009;Build 2
3 ;;David Bolduc - Togus, ME
4 ;; Called by XBHEDD3
5 N NODE
6 I 'FLAGP W @IOF,!!,$E(ZLINE,1,IOM)
7 S FLAGQ=0
8 F II=0,.1,2,3,4,12,12.1 S:$D(^DD(FILE(LEV),FNUM,II)) NODE(II)=^(II)
9 W !?M1,"FIELD NAME:",?M3,FNAM
10 W !!?M1,"FLD NUMBER:",?M3,FNUM,?36,"FLD TITLE: " W:$D(NODE(.1)) NODE(.1)
11 W !?M1,"NODE;PIECE:",?M3,$S($P(NODE(0),U,4)=" ; ":"Computed",1:$P(NODE(0),U,4))
12 W ?35,"HELP FRAME: " W:$D(^DD(FILE(LEV),FNUM,22)) ^(22)
13 W !!?M1," ACCESS:",?M3,"RD: ",$S($D(^DD(FILE(LEV),FNUM,8)):^(8),1:"")," ","DEL: ",$S($D(^(8.5)):^(8.5),1:"")," ","WR: ",$S($D(^(9)):^(9),1:"")
14DATATYPE S ZD=$P(NODE(0),U,2) W !!?M1," DATA TYPE:"
15 W ?M3,$S(ZD["C":"Computed",ZD["D":"Date/Time",ZD["F":"Free Text",ZD["N":"Numeric",ZD["P":"Pointer",ZD["S":"Set of Codes",ZD["W":"Word Processing",ZD["V":"Variable Pointer",ZD["K":"MUMPS code",1:"*****")
16 F I=1:1:$L(ZD) S ZDSUB=$E(ZD,I) D:"BIORX"[ZDSUB DTYPE1^XBHEDD5 D:"am*'"[ZDSUB DTYPE2^XBHEDD5
17 I ZD["S" F I=1:1:$L($P(NODE(0),U,3),";")-1 W !?M4,$P($P(NODE(0),U,3),";",I)
18 I ZD["P" S ZA="^"_$P(NODE(0),U,3) W !!?M1,"POINTS TO:",?M3 S ZB=ZA_"0)" W:$D(@ZB) $P(@ZB,U)," file - ",ZA W:'$D(@ZB) ZB," - Global doesn't exist."
19 I ZD["V"&($D(^DD(FILE(LEV),FNUM,"V",0))) W !!?M1,"POINTS TO:"
20 I S VAR=0 F I=0:0 S VAR=$O(^DD(FILE(LEV),FNUM,"V",VAR)) Q:VAR'>0 S ZDATA1=^DD(FILE(LEV),FNUM,"V",VAR,0) W ?M3,$P(ZDATA1,U),?M5,$P(ZDATA1,U,2) W:$O(^DD(FILE(LEV),FNUM,"V",VAR))>0 !
21 I $P(NODE(0),U,5)]"" W !!?M1,$S(ZD["C":"CODE CREATING X:",1:"INPUT TRANSFORM:") S STRING=$P(NODE(0),U,5,99) D STRING^XBHEDD5 G:FLAGQ EX
22 I $D(NODE(2)) W !!?M1,"OUTPUT TRANSFORM:" S STRING=NODE(2) D STRING^XBHEDD5 G:FLAGQ EX
23 I $D(^DD(FILE(LEV),FNUM,"DEL")) W !!?M1,"DELETE NODE(S):",?M3,"If $T is set to 1, no deleting." D
24 .S XX="" F S XX=$O(^DD(FILE(LEV),FNUM,"DEL",XX)) Q:XX="" W !?6,"Node: ",XX S STRING=^DD(FILE(LEV),FNUM,"DEL",XX,0) D STRING^XBHEDD5 Q:FLAGQ
25 G:FLAGQ EX
26 I $D(^DD(FILE(LEV),0,"ID",FNUM)) W !!?M1,"IDENTIFIER:" S STRING=^DD(FILE(LEV),0,"ID",FNUM) D STRING^XBHEDD5 G:FLAGQ EX
27 I $D(NODE(3)) W !!?M1,"PROMPT MESSAGE:" S STRING=NODE(3) D WORD^XBHEDD5 G:FLAGQ EX
28 I $D(NODE(12)) W !!?M1,"SCREEN: " S STRING=NODE(12) D STRING^XBHEDD5 G:FLAGQ EX
29 I $D(NODE(12.1)) W !?M1,"SCREEN CODE:" S STRING=NODE(12.1) D STRING^XBHEDD5 G:FLAGQ EX
30 I $D(^DD(FILE(LEV),FNUM,1)) D XREF G:FLAGQ EX
31 I $D(^DD(FILE(LEV),FNUM,21)) W ! D:$Y>SIZE PAGE^XBHEDD5 G:FLAGQ EX
32 I W !?M1,"DESCRIPTION:" S A=0 F S A=$O(^DD(FILE(LEV),FNUM,21,A)) Q:A=""!FLAGQ S STRING=^(A,0) D WORD^XBHEDD5 W !
33 G:FLAGQ EX
34 I $D(^DD(FILE(LEV),FNUM,22)),^(22)]"" D HELP G:FLAGQ EX
35EX ;
36 K LINE Q:FLAGQ
37 I 'FLAGP I $Y'>SIZE F I=$Y:1:SIZE W !
38 I 'FLAGP W !,$E(ZLINE,1,IOM)
39 Q
40XREF ;
41 S K=0 F S K=$O(^DD(FILE(LEV),FNUM,1,K)) Q:K=""!(K'>0)!FLAGQ S XREFNAM=$P(^DD(FILE(LEV),FNUM,1,K,0),U,2) S:XREFNAM="" XREFNAM="-----" S XREFTYPE=$P(^(0),U,3) S:XREFTYPE="" XREFTYPE="REGULAR" D XREF1
42 Q
43XREF1 ;
44 W ! D:$Y>SIZE PAGE^XBHEDD5 Q:FLAGQ
45 W !?M1,"CROSS REF NAME:",?M3,XREFNAM D:$Y>SIZE PAGE^XBHEDD5 Q:FLAGQ W !?12,"TYPE:",?M3,XREFTYPE D:$Y>SIZE PAGE^XBHEDD5 Q:FLAGQ
46 S L=0 F S L=$O(^DD(FILE(LEV),FNUM,1,K,L)) Q:L=""!FLAGQ D:L="%D" DESCRIP I $D(^(L))#2 W ! W:L'>0 ?M1,L W:L>0 ?6,"Node: ",L S STRING=^(L) D STRING^XBHEDD5 Q:FLAGQ
47 Q
48DESCRIP ;
49 W ! S M=0 F S M=$O(^DD(FILE(LEV),FNUM,1,K,L,M)) Q:M=""!FLAGQ W !,?M1 S STRING=^(M,0) D WORD^XBHEDD5 Q:FLAGQ
50 W ! Q
51HELP ;Print HELP FRAME text (^DIC(9.2,)
52 Q:FLAGP
53 W ! D:$Y>SIZE PAGE^XBHEDD5 Q:FLAGQ
54 W !?M1,"This field has a HELP FRAME." D:$Y>SIZE PAGE^XBHEDD5 Q:FLAGQ
55 R !?M1,"Do you wish to see the HELP FRAME text?: [YES/NO] NO//",ANS:DTIME S:'$T ANS="N" S:ANS="" ANS="N" Q:"Yy"'[$E(ANS)
56 S XQH=^DD(FILE(LEV),FNUM,22) D EN^XQH
57 K ANS,XQH Q
Note: See TracBrowser for help on using the repository browser.