INHMGD5 ;CAR; 7 Jul 97 10:42;HL7 MESSAGING - USER INPUT TO SENSITIVITY ANALYSIS
;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
;COPYRIGHT 1991-2000 SAIC
;
; MODULE NAME:
; HL7 Messaging - User Input to Sensitivity Analysis (INHMGD5).
;
SENSINP(INSENS) ;User input module for Sens field/file
; Purpose:
; This module is used to query the user for Field and File
; names or numbers to be looked up and reported on by the
; Sensitivity Analysis routine.
; Input:
; INSENS = Used merely as a flag on input
; Output:
; INSENS = An array to hold the requested File and Field numbers
; the format is: INSENS(FILE#,FIELD#)=""
; DUOUT = Normally doesn't exist, use $G(DUOUT) when checking
; Contains 1 when user "^" out of query, or 2 when user
; "timed-out" and 3 when user "^^" out of query.
;
;D ^UTSRD("query: ;;;;default;;;;;;;;;DUOUT",1) ;new format
;
N DIC,INJ,INL,INF,INFIL,INFOLD,INFLD,INFLDT,INHLP,INDONE
K DIC
;
S INHLP=" " ;add "^ D ...." to execute code
S INHLP(1)="Enter the CHCS/Fileman Field:File as numbers or names"
S INHLP(2)="Use a comma (,) to separate multiple Field:File requests"
S INHLP(3)="If you omit the file name/number entirely, you will be"
S INHLP(4)="asked for the first one, the rest will assume the same"
S INHLP(5)="file#, until you supply another one."
S (INFIL,INFOLD)=0
F D Q:X=""!$G(DUOUT)
.W ! D UTSRD("Enter CHCS Field:File[,Field:File,...]: ",.INHLP)
.Q:X=""!$G(DUOUT) ;terminates repeated entries
.;save the text, since we'll be using X:
.S INL=X
.;validate each entry (separated by ","):
.F INJ=1:1:$L(INL,",") D I $G(DUOUT) K:$G(DUOUT)'=3 DUOUT Q
..;extract field & file name/number and go into verify loop
..S INF=$P(INL,",",INJ) Q:'$L(INF)
..S INFLD=$P(INF,":"),INFIL=$P(INF,":",2),INDONE=0
..S INDONE=0 F D Q:INDONE!$G(DUOUT) ;loop till it's right or ^quit
...D I $G(DUOUT) K:$G(DUOUT)'=3 DUOUT Q
....S INF=INFIL,INFIL=0
....I '$L(INF),INFOLD S INFIL=INFOLD Q ;use file# from last time
....I INF,$D(^DIC(+INF,0))!$D(^DD(+INF,0)) S (INFOLD,INFIL)=INF Q
....I $L(INF) D
.....;may have a file NAME, do quiet lookup for number
.....K DIC S DIC="^DIC(",DIC(0)="FMZ",X=INF D ^DIC
.....I Y>0 S (INFIL,INFOLD)=+Y ;found it
...;-----------------------------
...;now, validate the field name:
...I $L(INFLD),INFIL D Q:Y>0
....;make sure this is the name of a field; quiet lookup
....K DIC S X=INFLD,DIC="^DD("_INFIL_",",DIC(0)="FMZ"
....D ^DIC
....;report success
....I Y>0 S INFLD=+Y D S INDONE=1 Q
.....S INFLDT=Y(0,0)
.....S INFILT=$P($G(^DIC(INFIL,0)),U)
.....I INFILT="" S INFILT=$P($G(^DD(INFIL,0)),U)
.....W !,?5,"Found Field#: "_INFLD_", ("_INFLDT_") in file#: "_INFIL_" "_$S($D(^DIC(INFIL,0)):$P(^(0),U),1:$P($G(^DD(INFIL,0)),U))
.....S INSENS(INFIL,INFLD)=""
...;lookup didn't work, re-ask the user for file and field
...W !,?5,"Could NOT find Entry# "_INJ_", Field/File: "_INFLD_":"_INFIL
...K DIC S DIC="^DIC(",DIC(0)="AEMQZ"
...I INFIL,$D(^DIC(+INFIL,0)) S DIC("B")=+INFIL
...S DIC("A")="Re-enter CHCS File (?? for list) or ^out: "
...D ^DIC
...I Y>0 D
....S (INFIL,INFOLD)=+Y
....;see if user wants sub-file
....K DIC S DIC="^DD("_+Y_",",DIC(0)="AEMQZ"
....S DIC("S")="I $P(^(0),U,2)"
....S DIC("A")="Select SUB-FILE: "
....D ^DIC I Y>0 S (INFIL,INFOLD)=+$P(Y(0),U,2)
...Q:$G(DUOUT)
...K DIC S DIC="^DD("_INFIL_",",DIC(0)="ACEQMZ"
...S DIC("A")="Re-enter Field (?? for list) or ^out: "
...I INFIL,INFLD,$D(^DD(INFIL,INFLD,0)) S DIC("B")=+INFLD
...D ^DIC I Y>0 S INFLD=+Y
Q
;
UTSRD(DIR,DIRH) ;adds arrayed help(for ?) and options(for ??) to D ^UTSRD(p1,p2)
; Inputs
; DIR = $p;1 is prompt, $p;5 is default, auto sets $p;14 to DUOUT
; DIRH = "^ code to list options,...?", DIRH(1)..DIRH(n) = help text
;
;set up DUOUT as variable to receive exit status from reader
S $P(DIR,";",14)="DUOUT"
;set up request to ^UTSRD to return any help, ? or ?? requests.
F D ^UTSRD(DIR,1) Q:X'["?"!$G(DUOUT) D
.;check if request is to execute some code (??) or (?) for help text.
.I $E(X,1,3)["??",$D(DIRH)#2,$E(DIRH)="^" D Q
..X $E(DIRH,2,999)
.;else, write any documentation; ?? falls through to ? if no code to X
.N INJ S INJ=0 F S INJ=$O(DIRH(INJ)) Q:'INJ W !,DIRH(INJ)
.W !
Q
;
INHMGD5 ;CAR; 7 Jul 97 10:42;HL7 MESSAGING - USER INPUT TO SENSITIVITY ANALYSIS
+1 ;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
+2 ;COPYRIGHT 1991-2000 SAIC
+3 ;
+4 ; MODULE NAME:
+5 ; HL7 Messaging - User Input to Sensitivity Analysis (INHMGD5).
+6 ;
SENSINP(INSENS) ;User input module for Sens field/file
+1 ; Purpose:
+2 ; This module is used to query the user for Field and File
+3 ; names or numbers to be looked up and reported on by the
+4 ; Sensitivity Analysis routine.
+5 ; Input:
+6 ; INSENS = Used merely as a flag on input
+7 ; Output:
+8 ; INSENS = An array to hold the requested File and Field numbers
+9 ; the format is: INSENS(FILE#,FIELD#)=""
+10 ; DUOUT = Normally doesn't exist, use $G(DUOUT) when checking
+11 ; Contains 1 when user "^" out of query, or 2 when user
+12 ; "timed-out" and 3 when user "^^" out of query.
+13 ;
+14 ;D ^UTSRD("query: ;;;;default;;;;;;;;;DUOUT",1) ;new format
+15 ;
+16 NEW DIC,INJ,INL,INF,INFIL,INFOLD,INFLD,INFLDT,INHLP,INDONE
+17 KILL DIC
+18 ;
+19 ;add "^ D ...." to execute code
SET INHLP=" "
+20 SET INHLP(1)="Enter the CHCS/Fileman Field:File as numbers or names"
+21 SET INHLP(2)="Use a comma (,) to separate multiple Field:File requests"
+22 SET INHLP(3)="If you omit the file name/number entirely, you will be"
+23 SET INHLP(4)="asked for the first one, the rest will assume the same"
+24 SET INHLP(5)="file#, until you supply another one."
+25 SET (INFIL,INFOLD)=0
+26 FOR
Begin DoDot:1
+27 WRITE !
DO UTSRD("Enter CHCS Field:File[,Field:File,...]: ",.INHLP)
+28 ;terminates repeated entries
IF X=""!$GET(DUOUT)
QUIT
+29 ;save the text, since we'll be using X:
+30 SET INL=X
+31 ;validate each entry (separated by ","):
+32 FOR INJ=1:1:$LENGTH(INL,",")
Begin DoDot:2
+33 ;extract field & file name/number and go into verify loop
+34 SET INF=$PIECE(INL,",",INJ)
IF '$LENGTH(INF)
QUIT
+35 SET INFLD=$PIECE(INF,":")
SET INFIL=$PIECE(INF,":",2)
SET INDONE=0
+36 ;loop till it's right or ^quit
SET INDONE=0
FOR
Begin DoDot:3
+37 Begin DoDot:4
+38 SET INF=INFIL
SET INFIL=0
+39 ;use file# from last time
IF '$LENGTH(INF)
IF INFOLD
SET INFIL=INFOLD
QUIT
+40 IF INF
IF $DATA(^DIC(+INF,0))!$DATA(^DD(+INF,0))
SET (INFOLD,INFIL)=INF
QUIT
+41 IF $LENGTH(INF)
Begin DoDot:5
+42 ;may have a file NAME, do quiet lookup for number
+43 KILL DIC
SET DIC="^DIC("
SET DIC(0)="FMZ"
SET X=INF
DO ^DIC
+44 ;found it
IF Y>0
SET (INFIL,INFOLD)=+Y
End DoDot:5
End DoDot:4
IF $GET(DUOUT)
IF $GET(DUOUT)'=3
KILL DUOUT
QUIT
+45 ;-----------------------------
+46 ;now, validate the field name:
+47 IF $LENGTH(INFLD)
IF INFIL
Begin DoDot:4
+48 ;make sure this is the name of a field; quiet lookup
+49 KILL DIC
SET X=INFLD
SET DIC="^DD("_INFIL_","
SET DIC(0)="FMZ"
+50 DO ^DIC
+51 ;report success
+52 IF Y>0
SET INFLD=+Y
Begin DoDot:5
+53 SET INFLDT=Y(0,0)
+54 SET INFILT=$PIECE($GET(^DIC(INFIL,0)),U)
+55 IF INFILT=""
SET INFILT=$PIECE($GET(^DD(INFIL,0)),U)
+56 WRITE !,?5,"Found Field#: "_INFLD_", ("_INFLDT_") in file#: "_INFIL_" "_$SELECT($DATA(^DIC(INFIL,0)):$PIECE(^(0),U),1:$PIECE($GET(^DD(INFIL,0)),U))
+57 SET INSENS(INFIL,INFLD)=""
End DoDot:5
SET INDONE=1
QUIT
End DoDot:4
IF Y>0
QUIT
+58 ;lookup didn't work, re-ask the user for file and field
+59 WRITE !,?5,"Could NOT find Entry# "_INJ_", Field/File: "_INFLD_":"_INFIL
+60 KILL DIC
SET DIC="^DIC("
SET DIC(0)="AEMQZ"
+61 IF INFIL
IF $DATA(^DIC(+INFIL,0))
SET DIC("B")=+INFIL
+62 SET DIC("A")="Re-enter CHCS File (?? for list) or ^out: "
+63 DO ^DIC
+64 IF Y>0
Begin DoDot:4
+65 SET (INFIL,INFOLD)=+Y
+66 ;see if user wants sub-file
+67 KILL DIC
SET DIC="^DD("_+Y_","
SET DIC(0)="AEMQZ"
+68 SET DIC("S")="I $P(^(0),U,2)"
+69 SET DIC("A")="Select SUB-FILE: "
+70 DO ^DIC
IF Y>0
SET (INFIL,INFOLD)=+$PIECE(Y(0),U,2)
End DoDot:4
+71 IF $GET(DUOUT)
QUIT
+72 KILL DIC
SET DIC="^DD("_INFIL_","
SET DIC(0)="ACEQMZ"
+73 SET DIC("A")="Re-enter Field (?? for list) or ^out: "
+74 IF INFIL
IF INFLD
IF $DATA(^DD(INFIL,INFLD,0))
SET DIC("B")=+INFLD
+75 DO ^DIC
IF Y>0
SET INFLD=+Y
End DoDot:3
IF INDONE!$GET(DUOUT)
QUIT
End DoDot:2
IF $GET(DUOUT)
IF $GET(DUOUT)'=3
KILL DUOUT
QUIT
End DoDot:1
IF X=""!$GET(DUOUT)
QUIT
+76 QUIT
+77 ;
UTSRD(DIR,DIRH) ;adds arrayed help(for ?) and options(for ??) to D ^UTSRD(p1,p2)
+1 ; Inputs
+2 ; DIR = $p;1 is prompt, $p;5 is default, auto sets $p;14 to DUOUT
+3 ; DIRH = "^ code to list options,...?", DIRH(1)..DIRH(n) = help text
+4 ;
+5 ;set up DUOUT as variable to receive exit status from reader
+6 SET $PIECE(DIR,";",14)="DUOUT"
+7 ;set up request to ^UTSRD to return any help, ? or ?? requests.
+8 FOR
DO ^UTSRD(DIR,1)
IF X'["?"!$GET(DUOUT)
QUIT
Begin DoDot:1
+9 ;check if request is to execute some code (??) or (?) for help text.
+10 IF $EXTRACT(X,1,3)["??"
IF $DATA(DIRH)#2
IF $EXTRACT(DIRH)="^"
Begin DoDot:2
+11 XECUTE $EXTRACT(DIRH,2,999)
End DoDot:2
QUIT
+12 ;else, write any documentation; ?? falls through to ? if no code to X
+13 NEW INJ
SET INJ=0
FOR
SET INJ=$ORDER(DIRH(INJ))
IF 'INJ
QUIT
WRITE !,DIRH(INJ)
+14 WRITE !
End DoDot:1
+15 QUIT
+16 ;
