XBHEDD9 ;402,DJB,10/23/91,EDD - NODE Lookup and Look-up by Global
;;2.6;IHS UTILITIES;;JUN 28, 1993
;;David Bolduc - Togus, ME
N FILE,FLD,NODE,NODE0,NODE1,PIECE
K ^UTILITY($J,"EDD/NP") S FILE=ZNUM
ND ;Lookup by NODE and PIECE
D NDGET G:FLAGQ EX D NDBLD
I '$D(^UTILITY($J,"EDD/NP")) W *7," No such node." G ND
ND1 D NDPRT G:FLAGQ EX
I $O(^UTILITY($J,"EDD/NP",NODE,""))=0 S FILE=+$P(^UTILITY($J,"EDD/NP",NODE,0),U,3),NODE1=NODE G ND
D NDSUM G:FLAGD ND G:FLAGE EX
S FLAGQ=0 G ND1
EX ;
S:'FLAGE FLAGQ=0 K NP,FLAGD,FNAM,FNUM,LEV,^UTILITY($J,"EDD/NP")
Q
NDGET ;Node get
W !
NDGET1 I FILE'=ZNUM W !,"Select '",NODE1,"' SUBNODE: "
E W !,"Select NODE: "
R NODE:DTIME S:'$T NODE="^" I "^"[NODE S FLAGQ=1 Q
I NODE="?" D HELP G NDGET1
Q
NDBLD ;
S FLD=0 K ^UTILITY($J,"EDD/NP")
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)
Q
NDPRT ;Print
S PIECE="" W @IOF D HD
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
Q
NDSUM ;
W !!?2,"You may now do an 'INDIVIDUAL FIELD SUMMARY'",!?2,"on the field(s) listed above.."
S FLAGD=0 W ! S DIC="^DD("_FILE_",",DIC(0)="QEAM" D ^DIC I Y<0 S FLAGD=1 Q
S FNUM=+Y,FNAM=$P(Y,U,2),LEV=1,FILE(LEV)=FILE D ^XBHEDD4 Q:FLAGQ
I $Y'>SIZE F I=$Y:1:SIZE W !
R ?2,"<RETURN> to continue..",XX:DTIME
Q
PAGE ;
R !!?2,"<RETURN> to continue, '^' to quit, '^' to exit: ",Z1:DTIME S:'$T Z1="^" I Z1["^" S FLAGQ=1 S:Z1="^^" FLAGE=1 Q
W @IOF D HD
Q
HELP ;
N FLD,NDTEMP
S FLD=0 K ^UTILITY($J,"EDD/NP")
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)=""
K ^UTILITY($J,"EDD/NP") Q
HD ;Node look-up
W !?3,"NODE ; PIECE",?20,"FLD NUM",?42,"FIELD NAME"
W !?3,"------------",?20,"-------",?32,"------------------------------"
Q
GLOBAL ;Find File when user enters global
K ^UTILITY($J) S (FLAGGL,FLAGGL1)=0
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
I $D(^UTILITY("EDD/GL",X)) S ZNUM=$P(^(X),U),ZNAM=$P(^(X),U,2),ZGL=X Q
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
I '$D(^UTILITY($J)) W *7," ??" S FLAGGL=1
Q:FLAGGL
I 'FLAGGL1 S I=(I-1) D GLPAGE1 Q:FLAGGL
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
I '$D(^UTILITY($J,Z1)) W *7," ??" S FLAGGL=1 Q
S ZNUM=$P(^UTILITY($J,Z1),"\~"),ZNAM=$P(^(Z1),"\~",2),ZGL=$P(^(Z1),"\~",3)
I '$D(^DD(ZNUM)) W *7," ?? This file has been deleted." S FLAGGL=1 ;Check to see if file still exists
Q
GLLIST ;List Globals
I I=1 W !?28,"FILE NUM",?38,"FILE NAME (Truncated to 32)",!?28,"--------",?38,"--------------------------------"
W !?3,$J(I,3)," ",XX,?28,$J($P(^UTILITY("EDD/GL",XX),U),8),?38,$E($P(^(XX),U,2),1,32)
S ^UTILITY($J,I)=$P(^UTILITY("EDD/GL",XX),U)_"\~"_$P(^(XX),U,2)_"\~"_XX
Q
GLPAGE ;
W !,"TYPE '^' TO STOP, OR",!,"CHOOSE NUMBER: "
R Z1:DTIME S:'$T Z1="^" I Z1="?" W " Enter a number from left hand column.." G GLPAGE
S:Z1["^" FLAGGL=1 I +Z1>0 S FLAGGL1=1
Q
GLPAGE1 ;
W !,"TYPE '^' TO STOP, OR",!,"CHOOSE NUMBER: "
R Z1:DTIME S:'$T Z1="^" I "^"[Z1!(+Z1'>0) S FLAGGL=1
I Z1="?" W " Enter a number from left hand column.." G GLPAGE1
Q
XBHEDD9 ;402,DJB,10/23/91,EDD - NODE Lookup and Look-up by Global
+1 ;;2.6;IHS UTILITIES;;JUN 28, 1993
+2 ;;David Bolduc - Togus, ME
+3 NEW FILE,FLD,NODE,NODE0,NODE1,PIECE
+4 KILL ^UTILITY($JOB,"EDD/NP")
SET FILE=ZNUM
ND ;Lookup by NODE and PIECE
+1 DO NDGET
IF FLAGQ
GOTO EX
DO NDBLD
+2 IF '$DATA(^UTILITY($JOB,"EDD/NP"))
WRITE *7," No such node."
GOTO ND
ND1 DO NDPRT
IF FLAGQ
GOTO EX
+1 IF $ORDER(^UTILITY($JOB,"EDD/NP",NODE,""))=0
SET FILE=+$PIECE(^UTILITY($JOB,"EDD/NP",NODE,0),U,3)
SET NODE1=NODE
GOTO ND
+2 DO NDSUM
IF FLAGD
GOTO ND
IF FLAGE
GOTO EX
+3 SET FLAGQ=0
GOTO ND1
EX ;
+1 IF 'FLAGE
SET FLAGQ=0
KILL NP,FLAGD,FNAM,FNUM,LEV,^UTILITY($JOB,"EDD/NP")
+2 QUIT
NDGET ;Node get
+1 WRITE !
NDGET1 IF FILE'=ZNUM
WRITE !,"Select '",NODE1,"' SUBNODE: "
+1 IF '$TEST
WRITE !,"Select NODE: "
+2 READ NODE:DTIME
IF '$TEST
SET NODE="^"
IF "^"[NODE
SET FLAGQ=1
QUIT
+3 IF NODE="?"
DO HELP
GOTO NDGET1
+4 QUIT
NDBLD ;
+1 SET FLD=0
KILL ^UTILITY($JOB,"EDD/NP")
+2 FOR
SET FLD=$ORDER(^DD(FILE,FLD))
IF FLD'>0
QUIT
IF $PIECE($PIECE(^DD(FILE,FLD,0),U,4),";")=NODE
SET NODE0=^(0)
SET NP=$PIECE(NODE0,U,4)
SET PIECE=$PIECE(NP,";",2)
SET ^UTILITY($JOB,"EDD/NP",NODE,PIECE)=FLD_U_$PIECE(NODE0,U,1,4)
+3 QUIT
NDPRT ;Print
+1 SET PIECE=""
WRITE @IOF
DO HD
+2 FOR
SET PIECE=$ORDER(^UTILITY($JOB,"EDD/NP",NODE,PIECE))
IF PIECE=""
QUIT
WRITE !?3,$JUSTIFY(NODE_";"_PIECE,12),?20,$JUSTIFY($PIECE(^UTILITY($JOB,"EDD/NP",NODE,PIECE),U),7),?32,$PIECE(^(PIECE),U,2)
IF $Y>SIZE
DO PAGE
IF FLAGQ=1
QUIT
+3 QUIT
NDSUM ;
+1 WRITE !!?2,"You may now do an 'INDIVIDUAL FIELD SUMMARY'",!?2,"on the field(s) listed above.."
+2 SET FLAGD=0
WRITE !
SET DIC="^DD("_FILE_","
SET DIC(0)="QEAM"
DO ^DIC
IF Y<0
SET FLAGD=1
QUIT
+3 SET FNUM=+Y
SET FNAM=$PIECE(Y,U,2)
SET LEV=1
SET FILE(LEV)=FILE
DO ^XBHEDD4
IF FLAGQ
QUIT
+4 IF $Y'>SIZE
FOR I=$Y:1:SIZE
WRITE !
+5 READ ?2,"<RETURN> to continue..",XX:DTIME
+6 QUIT
PAGE ;
+1 READ !!?2,"<RETURN> to continue, '^' to quit, '^' to exit: ",Z1:DTIME
IF '$TEST
SET Z1="^"
IF Z1["^"
SET FLAGQ=1
IF Z1="^^"
SET FLAGE=1
QUIT
+2 WRITE @IOF
DO HD
+3 QUIT
HELP ;
+1 NEW FLD,NDTEMP
+2 SET FLD=0
KILL ^UTILITY($JOB,"EDD/NP")
+3 FOR
SET FLD=$ORDER(^DD(FILE,FLD))
IF FLD'>0
QUIT
SET NDTEMP=$PIECE($PIECE(^DD(FILE,FLD,0),U,4),";")
IF '$DATA(^UTILITY($JOB,"EDD/NP",NDTEMP))#2
WRITE " ",NDTEMP
IF $X>70
WRITE !?5
SET ^UTILITY($JOB,"EDD/NP",NDTEMP)=""
+4 KILL ^UTILITY($JOB,"EDD/NP")
QUIT
HD ;Node look-up
+1 WRITE !?3,"NODE ; PIECE",?20,"FLD NUM",?42,"FIELD NAME"
+2 WRITE !?3,"------------",?20,"-------",?32,"------------------------------"
+3 QUIT
GLOBAL ;Find File when user enters global
+1 KILL ^UTILITY($JOB)
SET (FLAGGL,FLAGGL1)=0
+2 IF '$DATA(^UTILITY("EDD/GL"))
WRITE *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."
SET FLAGGL=1
QUIT
+3 IF $DATA(^UTILITY("EDD/GL",X))
SET ZNUM=$PIECE(^(X),U)
SET ZNAM=$PIECE(^(X),U,2)
SET ZGL=X
QUIT
+4 SET XX=X
FOR I=1:1
SET XX=$ORDER(^UTILITY("EDD/GL",XX))
IF XX=""!($EXTRACT(XX,1,$LENGTH(X))'=X)
QUIT
DO GLLIST
IF I#5=0
DO GLPAGE
IF FLAGGL!FLAGGL1
QUIT
+5 IF '$DATA(^UTILITY($JOB))
WRITE *7," ??"
SET FLAGGL=1
+6 IF FLAGGL
QUIT
+7 IF 'FLAGGL1
SET I=(I-1)
DO GLPAGE1
IF FLAGGL
QUIT
+8 IF Z1>I
FOR II=(I+1):1:Z1
SET XX=$ORDER(^UTILITY("EDD/GL",XX))
IF XX=""!($EXTRACT(XX,1,$LENGTH(X))'=X)
QUIT
SET ^UTILITY($JOB,II)=$PIECE(^UTILITY("EDD/GL",XX),U)_"\~"_$PIECE(^(XX),U,2)_"\~"_XX
+9 IF '$DATA(^UTILITY($JOB,Z1))
WRITE *7," ??"
SET FLAGGL=1
QUIT
+10 SET ZNUM=$PIECE(^UTILITY($JOB,Z1),"\~")
SET ZNAM=$PIECE(^(Z1),"\~",2)
SET ZGL=$PIECE(^(Z1),"\~",3)
+11 ;Check to see if file still exists
IF '$DATA(^DD(ZNUM))
WRITE *7," ?? This file has been deleted."
SET FLAGGL=1
+12 QUIT
GLLIST ;List Globals
+1 IF I=1
WRITE !?28,"FILE NUM",?38,"FILE NAME (Truncated to 32)",!?28,"--------",?38,"--------------------------------"
+2 WRITE !?3,$JUSTIFY(I,3)," ",XX,?28,$JUSTIFY($PIECE(^UTILITY("EDD/GL",XX),U),8),?38,$EXTRACT($PIECE(^(XX),U,2),1,32)
+3 SET ^UTILITY($JOB,I)=$PIECE(^UTILITY("EDD/GL",XX),U)_"\~"_$PIECE(^(XX),U,2)_"\~"_XX
+4 QUIT
GLPAGE ;
+1 WRITE !,"TYPE '^' TO STOP, OR",!,"CHOOSE NUMBER: "
+2 READ Z1:DTIME
IF '$TEST
SET Z1="^"
IF Z1="?"
WRITE " Enter a number from left hand column.."
GOTO GLPAGE
+3 IF Z1["^"
SET FLAGGL=1
IF +Z1>0
SET FLAGGL1=1
+4 QUIT
GLPAGE1 ;
+1 WRITE !,"TYPE '^' TO STOP, OR",!,"CHOOSE NUMBER: "
+2 READ Z1:DTIME
IF '$TEST
SET Z1="^"
IF "^"[Z1!(+Z1'>0)
SET FLAGGL=1
+3 IF Z1="?"
WRITE " Enter a number from left hand column.."
GOTO GLPAGE1
+4 QUIT
