- 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 ;
