- XBHEDD4 ;DJB,402,10/23/91,EDD - Individual Field Summary
- ;;2.6;IHS UTILITIES;;JUN 28, 1993
- ;;David Bolduc - Togus, ME
- ;; Called by XBHEDD3
- N NODE
- I 'FLAGP W @IOF,!!,$E(ZLINE,1,IOM)
- S FLAGQ=0
- F II=0,.1,2,3,4,12,12.1 S:$D(^DD(FILE(LEV),FNUM,II)) NODE(II)=^(II)
- W !?M1,"FIELD NAME:",?M3,FNAM
- W !!?M1,"FLD NUMBER:",?M3,FNUM,?36,"FLD TITLE: " W:$D(NODE(.1)) NODE(.1)
- W !?M1,"NODE;PIECE:",?M3,$S($P(NODE(0),U,4)=" ; ":"Computed",1:$P(NODE(0),U,4))
- W ?35,"HELP FRAME: " W:$D(^DD(FILE(LEV),FNUM,22)) ^(22)
- 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:"")
- DATATYPE S ZD=$P(NODE(0),U,2) W !!?M1," DATA TYPE:"
- 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:"*****")
- F I=1:1:$L(ZD) S ZDSUB=$E(ZD,I) D:"BIORX"[ZDSUB DTYPE1^XBHEDD5 D:"am*'"[ZDSUB DTYPE2^XBHEDD5
- I ZD["S" F I=1:1:$L($P(NODE(0),U,3),";")-1 W !?M4,$P($P(NODE(0),U,3),";",I)
- 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."
- I ZD["V"&($D(^DD(FILE(LEV),FNUM,"V",0))) W !!?M1,"POINTS TO:"
- 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 !
- 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
- I $D(NODE(2)) W !!?M1,"OUTPUT TRANSFORM:" S STRING=NODE(2) D STRING^XBHEDD5 G:FLAGQ EX
- I $D(^DD(FILE(LEV),FNUM,"DEL")) W !!?M1,"DELETE NODE(S):",?M3,"If $T is set to 1, no deleting." D
- .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
- G:FLAGQ EX
- 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
- I $D(NODE(3)) W !!?M1,"PROMPT MESSAGE:" S STRING=NODE(3) D WORD^XBHEDD5 G:FLAGQ EX
- I $D(NODE(12)) W !!?M1,"SCREEN: " S STRING=NODE(12) D STRING^XBHEDD5 G:FLAGQ EX
- I $D(NODE(12.1)) W !?M1,"SCREEN CODE:" S STRING=NODE(12.1) D STRING^XBHEDD5 G:FLAGQ EX
- I $D(^DD(FILE(LEV),FNUM,1)) D XREF G:FLAGQ EX
- I $D(^DD(FILE(LEV),FNUM,21)) W ! D:$Y>SIZE PAGE^XBHEDD5 G:FLAGQ EX
- 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 !
- G:FLAGQ EX
- I $D(^DD(FILE(LEV),FNUM,22)),^(22)]"" D HELP G:FLAGQ EX
- EX ;
- K LINE Q:FLAGQ
- I 'FLAGP I $Y'>SIZE F I=$Y:1:SIZE W !
- I 'FLAGP W !,$E(ZLINE,1,IOM)
- Q
- XREF ;
- 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
- Q
- XREF1 ;
- W ! D:$Y>SIZE PAGE^XBHEDD5 Q:FLAGQ
- 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
- 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
- Q
- DESCRIP ;
- 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
- W ! Q
- HELP ;Print HELP FRAME text (^DIC(9.2,)
- Q:FLAGP
- W ! D:$Y>SIZE PAGE^XBHEDD5 Q:FLAGQ
- W !?M1,"This field has a HELP FRAME." D:$Y>SIZE PAGE^XBHEDD5 Q:FLAGQ
- 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)
- S XQH=^DD(FILE(LEV),FNUM,22) D EN^XQH
- K ANS,XQH Q
- XBHEDD4 ;DJB,402,10/23/91,EDD - Individual Field Summary
- +1 ;;2.6;IHS UTILITIES;;JUN 28, 1993
- +2 ;;David Bolduc - Togus, ME
- +3 ;; Called by XBHEDD3
- +4 NEW NODE
- +5 IF 'FLAGP
- WRITE @IOF,!!,$EXTRACT(ZLINE,1,IOM)
- +6 SET FLAGQ=0
- +7 FOR II=0,.1,2,3,4,12,12.1
- IF $DATA(^DD(FILE(LEV),FNUM,II))
- SET NODE(II)=^(II)
- +8 WRITE !?M1,"FIELD NAME:",?M3,FNAM
- +9 WRITE !!?M1,"FLD NUMBER:",?M3,FNUM,?36,"FLD TITLE: "
- IF $DATA(NODE(.1))
- WRITE NODE(.1)
- +10 WRITE !?M1,"NODE;PIECE:",?M3,$SELECT($PIECE(NODE(0),U,4)=" ; ":"Computed",1:$PIECE(NODE(0),U,4))
- +11 WRITE ?35,"HELP FRAME: "
- IF $DATA(^DD(FILE(LEV),FNUM,22))
- WRITE ^(22)
- +12 WRITE !!?M1," ACCESS:",?M3,"RD: ",$SELECT($DATA(^DD(FILE(LEV),FNUM,8)):^(8),1:"")," ","DEL: ",$SELECT($DATA(^(8.5)):^(8.5),1:"")," ","WR: ",$SELECT($DATA(^(9)):^(9),1:"")
- DATATYPE SET ZD=$PIECE(NODE(0),U,2)
- WRITE !!?M1," DATA TYPE:"
- +1 WRITE ?M3,$SELECT(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:"*****")
- +2 FOR I=1:1:$LENGTH(ZD)
- SET ZDSUB=$EXTRACT(ZD,I)
- IF "BIORX"[ZDSUB
- DO DTYPE1^XBHEDD5
- IF "am*'"[ZDSUB
- DO DTYPE2^XBHEDD5
- +3 IF ZD["S"
- FOR I=1:1:$LENGTH($PIECE(NODE(0),U,3),";")-1
- WRITE !?M4,$PIECE($PIECE(NODE(0),U,3),";",I)
- +4 IF ZD["P"
- SET ZA="^"_$PIECE(NODE(0),U,3)
- WRITE !!?M1,"POINTS TO:",?M3
- SET ZB=ZA_"0)"
- IF $DATA(@ZB)
- WRITE $PIECE(@ZB,U)," file - ",ZA
- IF '$DATA(@ZB)
- WRITE ZB," - Global doesn't exist."
- +5 IF ZD["V"&($DATA(^DD(FILE(LEV),FNUM,"V",0)))
- WRITE !!?M1,"POINTS TO:"
- +6 IF $TEST
- SET VAR=0
- FOR I=0:0
- SET VAR=$ORDER(^DD(FILE(LEV),FNUM,"V",VAR))
- IF VAR'>0
- QUIT
- SET ZDATA1=^DD(FILE(LEV),FNUM,"V",VAR,0)
- WRITE ?M3,$PIECE(ZDATA1,U),?M5,$PIECE(ZDATA1,U,2)
- IF $ORDER(^DD(FILE(LEV),FNUM,"V",VAR))>0
- WRITE !
- +7 IF $PIECE(NODE(0),U,5)]""
- WRITE !!?M1,$SELECT(ZD["C":"CODE CREATING X:",1:"INPUT TRANSFORM:")
- SET STRING=$PIECE(NODE(0),U,5,99)
- DO STRING^XBHEDD5
- IF FLAGQ
- GOTO EX
- +8 IF $DATA(NODE(2))
- WRITE !!?M1,"OUTPUT TRANSFORM:"
- SET STRING=NODE(2)
- DO STRING^XBHEDD5
- IF FLAGQ
- GOTO EX
- +9 IF $DATA(^DD(FILE(LEV),FNUM,"DEL"))
- WRITE !!?M1,"DELETE NODE(S):",?M3,"If $T is set to 1, no deleting."
- Begin DoDot:1
- +10 SET XX=""
- FOR
- SET XX=$ORDER(^DD(FILE(LEV),FNUM,"DEL",XX))
- IF XX=""
- QUIT
- WRITE !?6,"Node: ",XX
- SET STRING=^DD(FILE(LEV),FNUM,"DEL",XX,0)
- DO STRING^XBHEDD5
- IF FLAGQ
- QUIT
- End DoDot:1
- +11 IF FLAGQ
- GOTO EX
- +12 IF $DATA(^DD(FILE(LEV),0,"ID",FNUM))
- WRITE !!?M1,"IDENTIFIER:"
- SET STRING=^DD(FILE(LEV),0,"ID",FNUM)
- DO STRING^XBHEDD5
- IF FLAGQ
- GOTO EX
- +13 IF $DATA(NODE(3))
- WRITE !!?M1,"PROMPT MESSAGE:"
- SET STRING=NODE(3)
- DO WORD^XBHEDD5
- IF FLAGQ
- GOTO EX
- +14 IF $DATA(NODE(12))
- WRITE !!?M1,"SCREEN: "
- SET STRING=NODE(12)
- DO STRING^XBHEDD5
- IF FLAGQ
- GOTO EX
- +15 IF $DATA(NODE(12.1))
- WRITE !?M1,"SCREEN CODE:"
- SET STRING=NODE(12.1)
- DO STRING^XBHEDD5
- IF FLAGQ
- GOTO EX
- +16 IF $DATA(^DD(FILE(LEV),FNUM,1))
- DO XREF
- IF FLAGQ
- GOTO EX
- +17 IF $DATA(^DD(FILE(LEV),FNUM,21))
- WRITE !
- IF $Y>SIZE
- DO PAGE^XBHEDD5
- IF FLAGQ
- GOTO EX
- +18 IF $TEST
- WRITE !?M1,"DESCRIPTION:"
- SET A=0
- FOR
- SET A=$ORDER(^DD(FILE(LEV),FNUM,21,A))
- IF A=""!FLAGQ
- QUIT
- SET STRING=^(A,0)
- DO WORD^XBHEDD5
- WRITE !
- +19 IF FLAGQ
- GOTO EX
- +20 IF $DATA(^DD(FILE(LEV),FNUM,22))
- IF ^(22)]""
- DO HELP
- IF FLAGQ
- GOTO EX
- EX ;
- +1 KILL LINE
- IF FLAGQ
- QUIT
- +2 IF 'FLAGP
- IF $Y'>SIZE
- FOR I=$Y:1:SIZE
- WRITE !
- +3 IF 'FLAGP
- WRITE !,$EXTRACT(ZLINE,1,IOM)
- +4 QUIT
- XREF ;
- +1 SET K=0
- FOR
- SET K=$ORDER(^DD(FILE(LEV),FNUM,1,K))
- IF K=""!(K'>0)!FLAGQ
- QUIT
- SET XREFNAM=$PIECE(^DD(FILE(LEV),FNUM,1,K,0),U,2)
- IF XREFNAM=""
- SET XREFNAM="-----"
- SET XREFTYPE=$PIECE(^(0),U,3)
- IF XREFTYPE=""
- SET XREFTYPE="REGULAR"
- DO XREF1
- +2 QUIT
- XREF1 ;
- +1 WRITE !
- IF $Y>SIZE
- DO PAGE^XBHEDD5
- IF FLAGQ
- QUIT
- +2 WRITE !?M1,"CROSS REF NAME:",?M3,XREFNAM
- IF $Y>SIZE
- DO PAGE^XBHEDD5
- IF FLAGQ
- QUIT
- WRITE !?12,"TYPE:",?M3,XREFTYPE
- IF $Y>SIZE
- DO PAGE^XBHEDD5
- IF FLAGQ
- QUIT
- +3 SET L=0
- FOR
- SET L=$ORDER(^DD(FILE(LEV),FNUM,1,K,L))
- IF L=""!FLAGQ
- QUIT
- IF L="%D"
- DO DESCRIP
- IF $DATA(^(L))#2
- WRITE !
- IF L'>0
- WRITE ?M1,L
- IF L>0
- WRITE ?6,"Node: ",L
- SET STRING=^(L)
- DO STRING^XBHEDD5
- IF FLAGQ
- QUIT
- +4 QUIT
- DESCRIP ;
- +1 WRITE !
- SET M=0
- FOR
- SET M=$ORDER(^DD(FILE(LEV),FNUM,1,K,L,M))
- IF M=""!FLAGQ
- QUIT
- WRITE !,?M1
- SET STRING=^(M,0)
- DO WORD^XBHEDD5
- IF FLAGQ
- QUIT
- +2 WRITE !
- QUIT
- HELP ;Print HELP FRAME text (^DIC(9.2,)
- +1 IF FLAGP
- QUIT
- +2 WRITE !
- IF $Y>SIZE
- DO PAGE^XBHEDD5
- IF FLAGQ
- QUIT
- +3 WRITE !?M1,"This field has a HELP FRAME."
- IF $Y>SIZE
- DO PAGE^XBHEDD5
- IF FLAGQ
- QUIT
- +4 READ !?M1,"Do you wish to see the HELP FRAME text?: [YES/NO] NO//",ANS:DTIME
- IF '$TEST
- SET ANS="N"
- IF ANS=""
- SET ANS="N"
- IF "Yy"'[$EXTRACT(ANS)
- QUIT
- +5 SET XQH=^DD(FILE(LEV),FNUM,22)
- DO EN^XQH
- +6 KILL ANS,XQH
- QUIT
