| 1 | XBHEDD9 ;402,DJB,10/23/91,EDD - NODE Lookup and Look-up by Global
|
|---|
| 2 | ;;4.0;XB;;Jul 20, 2009;Build 2
|
|---|
| 3 | ;;David Bolduc - Togus, ME
|
|---|
| 4 | N FILE,FLD,NODE,NODE0,NODE1,PIECE
|
|---|
| 5 | K ^UTILITY($J,"EDD/NP") S FILE=ZNUM
|
|---|
| 6 | ND ;Lookup by NODE and PIECE
|
|---|
| 7 | D NDGET G:FLAGQ EX D NDBLD
|
|---|
| 8 | I '$D(^UTILITY($J,"EDD/NP")) W *7," No such node." G ND
|
|---|
| 9 | ND1 D NDPRT G:FLAGQ EX
|
|---|
| 10 | I $O(^UTILITY($J,"EDD/NP",NODE,""))=0 S FILE=+$P(^UTILITY($J,"EDD/NP",NODE,0),U,3),NODE1=NODE G ND
|
|---|
| 11 | D NDSUM G:FLAGD ND G:FLAGE EX
|
|---|
| 12 | S FLAGQ=0 G ND1
|
|---|
| 13 | EX ;
|
|---|
| 14 | S:'FLAGE FLAGQ=0 K NP,FLAGD,FNAM,FNUM,LEV,^UTILITY($J,"EDD/NP")
|
|---|
| 15 | Q
|
|---|
| 16 | NDGET ;Node get
|
|---|
| 17 | W !
|
|---|
| 18 | NDGET1 I FILE'=ZNUM W !,"Select '",NODE1,"' SUBNODE: "
|
|---|
| 19 | E W !,"Select NODE: "
|
|---|
| 20 | R NODE:DTIME S:'$T NODE="^" I "^"[NODE S FLAGQ=1 Q
|
|---|
| 21 | I NODE="?" D HELP G NDGET1
|
|---|
| 22 | Q
|
|---|
| 23 | NDBLD ;
|
|---|
| 24 | S FLD=0 K ^UTILITY($J,"EDD/NP")
|
|---|
| 25 | F S FLD=$O(^DD(FILE,FLD)) Q:FLD'>0 I $P($P(^DD(FILE,FLD,0),U,4),";")=NODE S NODE0=^(0),NP=$P(NODE0,U,4),PIECE=$P(NP,";",2),^UTILITY($J,"EDD/NP",NODE,PIECE)=FLD_U_$P(NODE0,U,1,4)
|
|---|
| 26 | Q
|
|---|
| 27 | NDPRT ;Print
|
|---|
| 28 | S PIECE="" W @IOF D HD
|
|---|
| 29 | F S PIECE=$O(^UTILITY($J,"EDD/NP",NODE,PIECE)) Q:PIECE="" W !?3,$J(NODE_";"_PIECE,12),?20,$J($P(^UTILITY($J,"EDD/NP",NODE,PIECE),U),7),?32,$P(^(PIECE),U,2) I $Y>SIZE D PAGE Q:FLAGQ=1
|
|---|
| 30 | Q
|
|---|
| 31 | NDSUM ;
|
|---|
| 32 | W !!?2,"You may now do an 'INDIVIDUAL FIELD SUMMARY'",!?2,"on the field(s) listed above.."
|
|---|
| 33 | S FLAGD=0 W ! S DIC="^DD("_FILE_",",DIC(0)="QEAM" D ^DIC I Y<0 S FLAGD=1 Q
|
|---|
| 34 | S FNUM=+Y,FNAM=$P(Y,U,2),LEV=1,FILE(LEV)=FILE D ^XBHEDD4 Q:FLAGQ
|
|---|
| 35 | I $Y'>SIZE F I=$Y:1:SIZE W !
|
|---|
| 36 | R ?2,"<RETURN> to continue..",XX:DTIME
|
|---|
| 37 | Q
|
|---|
| 38 | PAGE ;
|
|---|
| 39 | R !!?2,"<RETURN> to continue, '^' to quit, '^' to exit: ",Z1:DTIME S:'$T Z1="^" I Z1["^" S FLAGQ=1 S:Z1="^^" FLAGE=1 Q
|
|---|
| 40 | W @IOF D HD
|
|---|
| 41 | Q
|
|---|
| 42 | HELP ;
|
|---|
| 43 | N FLD,NDTEMP
|
|---|
| 44 | S FLD=0 K ^UTILITY($J,"EDD/NP")
|
|---|
| 45 | F S FLD=$O(^DD(FILE,FLD)) Q:FLD'>0 S NDTEMP=$P($P(^DD(FILE,FLD,0),U,4),";") W:'$D(^UTILITY($J,"EDD/NP",NDTEMP))#2 " ",NDTEMP W:$X>70 !?5 S ^UTILITY($J,"EDD/NP",NDTEMP)=""
|
|---|
| 46 | K ^UTILITY($J,"EDD/NP") Q
|
|---|
| 47 | HD ;Node look-up
|
|---|
| 48 | W !?3,"NODE ; PIECE",?20,"FLD NUM",?42,"FIELD NAME"
|
|---|
| 49 | W !?3,"------------",?20,"-------",?32,"------------------------------"
|
|---|
| 50 | Q
|
|---|
| 51 | GLOBAL ;Find File when user enters global
|
|---|
| 52 | K ^UTILITY($J) S (FLAGGL,FLAGGL1)=0
|
|---|
| 53 | I '$D(^UTILITY("EDD/GL")) W *7,!?25,"You have no data in ^UTILITY(""EDD/GL""). You must run",!?25,"option 10, List Globals in ASCII Order, before you",!?25,"can do a lookup on a global." S FLAGGL=1 Q
|
|---|
| 54 | I $D(^UTILITY("EDD/GL",X)) S ZNUM=$P(^(X),U),ZNAM=$P(^(X),U,2),ZGL=X Q
|
|---|
| 55 | S XX=X F I=1:1 S XX=$O(^UTILITY("EDD/GL",XX)) Q:XX=""!($E(XX,1,$L(X))'=X) D GLLIST I I#5=0 D GLPAGE Q:FLAGGL!FLAGGL1
|
|---|
| 56 | I '$D(^UTILITY($J)) W *7," ??" S FLAGGL=1
|
|---|
| 57 | Q:FLAGGL
|
|---|
| 58 | I 'FLAGGL1 S I=(I-1) D GLPAGE1 Q:FLAGGL
|
|---|
| 59 | I Z1>I F II=(I+1):1:Z1 S XX=$O(^UTILITY("EDD/GL",XX)) Q:XX=""!($E(XX,1,$L(X))'=X) S ^UTILITY($J,II)=$P(^UTILITY("EDD/GL",XX),U)_"\~"_$P(^(XX),U,2)_"\~"_XX
|
|---|
| 60 | I '$D(^UTILITY($J,Z1)) W *7," ??" S FLAGGL=1 Q
|
|---|
| 61 | S ZNUM=$P(^UTILITY($J,Z1),"\~"),ZNAM=$P(^(Z1),"\~",2),ZGL=$P(^(Z1),"\~",3)
|
|---|
| 62 | I '$D(^DD(ZNUM)) W *7," ?? This file has been deleted." S FLAGGL=1 ;Check to see if file still exists
|
|---|
| 63 | Q
|
|---|
| 64 | GLLIST ;List Globals
|
|---|
| 65 | I I=1 W !?28,"FILE NUM",?38,"FILE NAME (Truncated to 32)",!?28,"--------",?38,"--------------------------------"
|
|---|
| 66 | W !?3,$J(I,3)," ",XX,?28,$J($P(^UTILITY("EDD/GL",XX),U),8),?38,$E($P(^(XX),U,2),1,32)
|
|---|
| 67 | S ^UTILITY($J,I)=$P(^UTILITY("EDD/GL",XX),U)_"\~"_$P(^(XX),U,2)_"\~"_XX
|
|---|
| 68 | Q
|
|---|
| 69 | GLPAGE ;
|
|---|
| 70 | W !,"TYPE '^' TO STOP, OR",!,"CHOOSE NUMBER: "
|
|---|
| 71 | R Z1:DTIME S:'$T Z1="^" I Z1="?" W " Enter a number from left hand column.." G GLPAGE
|
|---|
| 72 | S:Z1["^" FLAGGL=1 I +Z1>0 S FLAGGL1=1
|
|---|
| 73 | Q
|
|---|
| 74 | GLPAGE1 ;
|
|---|
| 75 | W !,"TYPE '^' TO STOP, OR",!,"CHOOSE NUMBER: "
|
|---|
| 76 | R Z1:DTIME S:'$T Z1="^" I "^"[Z1!(+Z1'>0) S FLAGGL=1
|
|---|
| 77 | I Z1="?" W " Enter a number from left hand column.." G GLPAGE1
|
|---|
| 78 | Q
|
|---|
