INHMGD.m

INHMGD ;CAR; 1 Aug 97 10:23;HL7 MESSAGING - MANAGEMENT OF DATA SOURCES

 ;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001

 ;COPYRIGHT 1991-2000 SAIC

 ;

 ; MODULE NAME: HL7 Message Data Sources utility (INHMGD)

 ;

 ; PURPOSE:

 ; Module INHMGD is used to extract information describing the

 ; source file and field for HL7 Messages, or to list all Messages

 ; that reference a specific field.

 ;

 ;DESCRIPTION:

 ;This routine prompts the user for a HL7 Message Name, then displays

 ;the associated Segments and for each segment, display the Fields

 ;and the data address for each Field.  Alternatively, the user can

 ;request that a listing for all messages be sent to a file.  Or, the

 ;user can request a sensitivity analysis where the user supplies a

 ;data address, and the routine lists all of the messages that

 ;reference that address.

 ;

 ;ENTRY POINTS:

 ;  EN  = Extract source data addresses for specific messages.

 ;  EN1 = List messages referencing a specific data address.

 ;

 ; Return: None

 ; Parameters: None

 ;

EN ; Entry point for the HL7 Message Data Sources utility

 K INSENS N INSENS S INSENS=0

 ;

EN1 ; Entry point for the HL7/CHCS Field Sensitivity Analysis

 I '$D(INSENS) N INSENS S INSENS=1

 N DIC,INALL,INAM,INCSG,INDA,POP,INQUIT

 K DUOUT,POP,DIC

 ;

 ;new leftover variables

 N %,%Y,%DT,DA,DICOMPX,DIJC,DIRCP,DIRI,DIRMAX,DOY,DQI,DUOUT,INEXIT,INFIN,INFLD,J,X,Y,INPERR,INEOR

 S (INEXIT,INQUIT)=0,INCSG=1 ;INCSG=flag for Print common segments?

 ;

 ;All fields/messages?

 S INALL=$$INALL($S(INSENS:"mapped fields",1:"messages")) Q:INEXIT

 ;

 ;Else  Ask for field/message names

 I 'INALL D  Q:$G(DUOUT)!INQUIT

 .;query user for fields to lookup in sensitivity analysis

 .I INSENS D SENSINP^INHMGD5(.INSENS) Q

 .;OR, for message name, then DIC lookup for the IEN

 .S DIWF="",DIC="^INTHL7M(",DIC(0)="AEQ"

 .S DIC("A")="SELECT SCRIPT GENERATOR MESSAGE: "

 .D ^DIC I Y>0 S INAM=$P(Y,U,2),INDA=+Y Q

 .S INQUIT=1

 ;

 ;If not sensitivity analysis, ask: include the common segments?

 I 'INSENS S INCSG=$$COMMON Q:INEXIT

 ;

 ;Print lookup errors?

 S INPERR=$$INPERR Q:$G(DUOUT)

 I 'INALL,'INPERR,INSENS,'$O(INSENS(0)) Q  ;nothing to do

 ;

 ;set up Device handling:

 N %ZIS,INHDR,INP,ZTDESC,ZTIO,ZTRTN,ZTDTH,ZTSAVE

 K IOP S %ZIS("A")="QUEUE ON DEVICE: ",%ZIS("B")="",%ZIS="NQ"

 D ^%ZIS I POP S IOP="",%ZIS="" D ^%ZIS U IO K IO("Q"),IOP,POP Q

 S IOP=ION_";"_IOST_";"_IOM_";"_IOSL

 ;

 ;Ask user, "Write an abbreviated copy of the output to a file?"

 S INP=0 I 'INSENS,'INPERR,ION[".DAT" S INP=$$TABOUT Q:INEXIT

 ;

 ;queue job up for a printer or send to a file:

 I IO'=IO(0) D  S IOP="",%ZIS="" D ^%ZIS U IO K IO("Q"),IOP,POP Q

 .S ZTDESC="HL7 Data Source Management"

 .S ZTRTN="ENQUE^INHMGD"

 .S ZTIO=IOP

 .;S ZTDTH=$H,$P(ZTDTH,",",2)=$P(ZTDTH,",",2)+5

 .F X="INALL","INAM","INDA","INCSG","INP","INSENS","INSENS(","INPERR" S ZTSAVE(X)=""

 .D ^%ZTLOAD

 ;

 ;else, fall through to Taskman entry point and send output to user

 I IO=IO(0) S %ZIS="" D ^%ZIS I POP D  S IOP="" D ^%ZIS U IO K POP Q

 .W *7,!,"Sorry, unable to find device..."

 ;

ENQUE ;Taskman entry point

 ;where INAM [ Message Name and INDA [ IEN of that message.

 K ^UTILITY("INHMGD",$J) ;just in case we did ^C out last time.

 N INDATA,INDT,INOFF,INEXIT,INDHT,INERN,INJ,INHDR

 N INMODE,INPAGE,INPARS,INTRP,DATA,INX,J,K,INQ,FILE,FLVL,INS2,ING

 ;

 S (ING,INERN)=0

 I IOM=132 S ING=IOM-12 N IOM S IOM=ING,ING=8

 ;setup for field column (see INHMGD4 for remainder of columns)

 S INS2=$S(IOM>90:58,1:47)+ING ;start of column2

 ;

 S INDA=$G(INDA,0),INAM=$G(INAM),INALL=$G(INALL,0)

 S INP=$G(INP),IOP=$G(IOP),INSENS=$G(INSENS),INPAGE=""

 ;

 S INEXIT=0

 S INDT=$$CDATASC^UTDT($H,1,1)

 S INOFF=$S(IOM>80:IOM-80,1:0) ;printing offsets based on width IOM

 ;

 ;if we are printing all (INALL>0) messages, then:

 I 'INSENS,INALL N INDA S INAM="" D  Q:INEXIT

 .F  S INAM=$O(^INTHL7M("B",INAM))   Q:INAM=""!INEXIT  D

 ..S INDA=0 F  S INDA=$O(^INTHL7M("B",INAM,INDA)) Q:'INDA  D

 ...I "TESTPROTO"[$P(^INTHL7M(INDA,0)," ") Q

 ...D IN^INHMGD1(INDA,.INP)

 ;

 ;we are not printing all messages, just one.

 I 'INSENS,'INALL D IN^INHMGD1(INDA,.INP) Q:INEXIT

 ;

 ;is this a SENSITIVITY ANALYSIS?

 I INSENS D

 .D INSUPDT^INHMGD6

 .D INSPRNT^INHMGD8(.INSENS,INALL)

 ;

 ;Print *****End of Report***** and pause to let user read last page

 S INEOR="*****End of Report*****"

 I INPAGE,'INP,'INEXIT D

 .S (INHDR(4),INDATA)="$C(32)" F INJ=1:1:3 D INW^INHMGD8(INJ=1)

 .S INDATA="$$DASH^INHMGD1(IOM-$L(INEOR)\2,"" "")_INEOR" D INW^INHMGD8(0)

 .;pause to let user read last page

 .I $E(IOST)="C",'$D(IO("Q")),IO=IO(0) S DUOUT=$$CR^UTSRD

 ;

 ;Print Errors?

 I INPERR,'INEXIT D INPERR^INHMGD9

 K ^UTILITY("INHMGD",$J)

 ;

 D ^%ZISC

 Q

 ;

INALL(UNITS) ;do you want all (fields/messages)?

 N INHLP,X

 S INHLP="Answer ""Y"" to display all "_UNITS

 S INHLP=INHLP_", ""N"" to select individual "_UNITS_"."

 S X=$$YN^UTSRD("Do you wish to print ALL "_UNITS_"? ;0",INHLP)

 I $P(X,U,2)]"" S INEXIT=1

 Q X

 ;

COMMON() ;do you want the common segments?

 N INHLP,X

 S INHLP="Do you want to include the Message Header segment (MSH) "

 S INHLP=INHLP_"and the Patient ID segment (PID)?"

 S X=$$YN^UTSRD("Include the COMMON SEGMENTS (MSH and PID)? ;0",INHLP)

 I $P(X,U,2)]"" S INEXIT=1

 Q X

 ;

INPERR() ;do you want to print any lookup errors?

 N INHLP

 S INHLP="Lists non-existant CHCS fields and multiply defined HL7 Message Segments"

 S X=$$YN^UTSRD("Print ""Lookup Errors"" listing? ;0",INHLP)

 I $P(X,U,2)]"" S INEXIT=1

 Q X

 ;

TABOUT() ;set up the output for exporting as a tab-delimited file?

 N INHLP,X

 S INHLP="A tab-delimited VMS file can be easily imported into desk-top applications."

 S X=$$YN^UTSRD("Do you want this file to be tab-delimited? ;0",INHLP)

 I $P(X,U,2)]"" S INEXIT=1

 Q X

 ;

INHMGD    ;CAR; 1 Aug 97 10:23;HL7 MESSAGING - MANAGEMENT OF DATA SOURCES

 +1       ;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001

 +2       ;COPYRIGHT 1991-2000 SAIC

 +3       ;

 +4       ; MODULE NAME: HL7 Message Data Sources utility (INHMGD)

 +5       ;

 +6       ; PURPOSE:

 +7       ; Module INHMGD is used to extract information describing the

 +8       ; source file and field for HL7 Messages, or to list all Messages

 +9       ; that reference a specific field.

 +10      ;

 +11      ;DESCRIPTION:

 +12      ;This routine prompts the user for a HL7 Message Name, then displays

 +13      ;the associated Segments and for each segment, display the Fields

 +14      ;and the data address for each Field.  Alternatively, the user can

 +15      ;request that a listing for all messages be sent to a file.  Or, the

 +16      ;user can request a sensitivity analysis where the user supplies a

 +17      ;data address, and the routine lists all of the messages that

 +18      ;reference that address.

 +19      ;

 +20      ;ENTRY POINTS:

 +21      ;  EN  = Extract source data addresses for specific messages.

 +22      ;  EN1 = List messages referencing a specific data address.

 +23      ;

 +24      ; Return: None

 +25      ; Parameters: None

 +26      ;

EN        ; Entry point for the HL7 Message Data Sources utility

 +1        KILL INSENS

           NEW INSENS

           SET INSENS=0

 +2       ;

EN1       ; Entry point for the HL7/CHCS Field Sensitivity Analysis

 +1        IF '$DATA(INSENS)

               NEW INSENS

               SET INSENS=1

 +2        NEW DIC,INALL,INAM,INCSG,INDA,POP,INQUIT

 +3        KILL DUOUT,POP,DIC

 +4       ;

 +5       ;new leftover variables

 +6        NEW %,%Y,%DT,DA,DICOMPX,DIJC,DIRCP,DIRI,DIRMAX,DOY,DQI,DUOUT,INEXIT,INFIN,INFLD,J,X,Y,INPERR,INEOR

 +7       ;INCSG=flag for Print common segments?

           SET (INEXIT,INQUIT)=0

           SET INCSG=1

 +8       ;

 +9       ;All fields/messages?

 +10       SET INALL=$$INALL($SELECT(INSENS:"mapped fields",1:"messages"))

           IF INEXIT

               QUIT 

 +11      ;

 +12      ;Else  Ask for field/message names

 +13       IF 'INALL

               Begin DoDot:1

 +14      ;query user for fields to lookup in sensitivity analysis

 +15               IF INSENS

                       DO SENSINP^INHMGD5(.INSENS)

                       QUIT 

 +16      ;OR, for message name, then DIC lookup for the IEN

 +17               SET DIWF=""

                   SET DIC="^INTHL7M("

                   SET DIC(0)="AEQ"

 +18               SET DIC("A")="SELECT SCRIPT GENERATOR MESSAGE: "

 +19               DO ^DIC

                   IF Y>0

                       SET INAM=$PIECE(Y,U,2)

                       SET INDA=+Y

                       QUIT 

 +20               SET INQUIT=1

               End DoDot:1

               IF $GET(DUOUT)!INQUIT

                   QUIT 

 +21      ;

 +22      ;If not sensitivity analysis, ask: include the common segments?

 +23       IF 'INSENS

               SET INCSG=$$COMMON

               IF INEXIT

                   QUIT 

 +24      ;

 +25      ;Print lookup errors?

 +26       SET INPERR=$$INPERR

           IF $GET(DUOUT)

               QUIT 

 +27      ;nothing to do

           IF 'INALL

               IF 'INPERR

                   IF INSENS

                       IF '$ORDER(INSENS(0))

                           QUIT 

 +28      ;

 +29      ;set up Device handling:

 +30       NEW %ZIS,INHDR,INP,ZTDESC,ZTIO,ZTRTN,ZTDTH,ZTSAVE

 +31       KILL IOP

           SET %ZIS("A")="QUEUE ON DEVICE: "

           SET %ZIS("B")=""

           SET %ZIS="NQ"

 +32       DO ^%ZIS

           IF POP

               SET IOP=""

               SET %ZIS=""

               DO ^%ZIS

               USE IO

               KILL IO("Q"),IOP,POP

               QUIT 

 +33       SET IOP=ION_";"_IOST_";"_IOM_";"_IOSL

 +34      ;

 +35      ;Ask user, "Write an abbreviated copy of the output to a file?"

 +36       SET INP=0

           IF 'INSENS

               IF 'INPERR

                   IF ION[".DAT"

                       SET INP=$$TABOUT

                       IF INEXIT

                           QUIT 

 +37      ;

 +38      ;queue job up for a printer or send to a file:

 +39       IF IO'=IO(0)

               Begin DoDot:1

 +40               SET ZTDESC="HL7 Data Source Management"

 +41               SET ZTRTN="ENQUE^INHMGD"

 +42               SET ZTIO=IOP

 +43      ;S ZTDTH=$H,$P(ZTDTH,",",2)=$P(ZTDTH,",",2)+5

 +44               FOR X="INALL","INAM","INDA","INCSG","INP","INSENS","INSENS(","INPERR"

                       SET ZTSAVE(X)=""

 +45               DO ^%ZTLOAD

               End DoDot:1

               SET IOP=""

               SET %ZIS=""

               DO ^%ZIS

               USE IO

               KILL IO("Q"),IOP,POP

               QUIT 

 +46      ;

 +47      ;else, fall through to Taskman entry point and send output to user

 +48       IF IO=IO(0)

               SET %ZIS=""

               DO ^%ZIS

               IF POP

                   Begin DoDot:1

 +49                   WRITE *7,!,"Sorry, unable to find device..."

                   End DoDot:1

                   SET IOP=""

                   DO ^%ZIS

                   USE IO

                   KILL POP

                   QUIT 

 +50      ;

ENQUE     ;Taskman entry point

 +1       ;where INAM [ Message Name and INDA [ IEN of that message.

 +2       ;just in case we did ^C out last time.

           KILL ^UTILITY("INHMGD",$JOB)

 +3        NEW INDATA,INDT,INOFF,INEXIT,INDHT,INERN,INJ,INHDR

 +4        NEW INMODE,INPAGE,INPARS,INTRP,DATA,INX,J,K,INQ,FILE,FLVL,INS2,ING

 +5       ;

 +6        SET (ING,INERN)=0

 +7        IF IOM=132

               SET ING=IOM-12

               NEW IOM

               SET IOM=ING

               SET ING=8

 +8       ;setup for field column (see INHMGD4 for remainder of columns)

 +9       ;start of column2

           SET INS2=$SELECT(IOM>90:58,1:47)+ING

 +10      ;

 +11       SET INDA=$GET(INDA,0)

           SET INAM=$GET(INAM)

           SET INALL=$GET(INALL,0)

 +12       SET INP=$GET(INP)

           SET IOP=$GET(IOP)

           SET INSENS=$GET(INSENS)

           SET INPAGE=""

 +13      ;

 +14       SET INEXIT=0

 +15       SET INDT=$$CDATASC^UTDT($HOROLOG,1,1)

 +16      ;printing offsets based on width IOM

           SET INOFF=$SELECT(IOM>80:IOM-80,1:0)

 +17      ;

 +18      ;if we are printing all (INALL>0) messages, then:

 +19       IF 'INSENS

               IF INALL

                   NEW INDA

                   SET INAM=""

                   Begin DoDot:1

 +20                   FOR 

                           SET INAM=$ORDER(^INTHL7M("B",INAM))

                           IF INAM=""!INEXIT

                               QUIT 

                           Begin DoDot:2

 +21                           SET INDA=0

                               FOR 

                                   SET INDA=$ORDER(^INTHL7M("B",INAM,INDA))

                                   IF 'INDA

                                       QUIT 

                                   Begin DoDot:3

 +22                                   IF "TESTPROTO"[$PIECE(^INTHL7M(INDA,0)," ")

                                           QUIT 

 +23                                   DO IN^INHMGD1(INDA,.INP)

                                   End DoDot:3

                           End DoDot:2

                   End DoDot:1

                   IF INEXIT

                       QUIT 

 +24      ;

 +25      ;we are not printing all messages, just one.

 +26       IF 'INSENS

               IF 'INALL

                   DO IN^INHMGD1(INDA,.INP)

                   IF INEXIT

                       QUIT 

 +27      ;

 +28      ;is this a SENSITIVITY ANALYSIS?

 +29       IF INSENS

               Begin DoDot:1

 +30               DO INSUPDT^INHMGD6

 +31               DO INSPRNT^INHMGD8(.INSENS,INALL)

               End DoDot:1

 +32      ;

 +33      ;Print *****End of Report***** and pause to let user read last page

 +34       SET INEOR="*****End of Report*****"

 +35       IF INPAGE

               IF 'INP

                   IF 'INEXIT

                       Begin DoDot:1

 +36                       SET (INHDR(4),INDATA)="$C(32)"

                           FOR INJ=1:1:3

                               DO INW^INHMGD8(INJ=1)

 +37                       SET INDATA="$$DASH^INHMGD1(IOM-$L(INEOR)\2,"" "")_INEOR"

                           DO INW^INHMGD8(0)

 +38      ;pause to let user read last page

 +39                       IF $EXTRACT(IOST)="C"

                               IF '$DATA(IO("Q"))

                                   IF IO=IO(0)

                                       SET DUOUT=$$CR^UTSRD

                       End DoDot:1

 +40      ;

 +41      ;Print Errors?

 +42       IF INPERR

               IF 'INEXIT

                   DO INPERR^INHMGD9

 +43       KILL ^UTILITY("INHMGD",$JOB)

 +44      ;

 +45       DO ^%ZISC

 +46       QUIT 

 +47      ;

INALL(UNITS) ;do you want all (fields/messages)?

 +1        NEW INHLP,X

 +2        SET INHLP="Answer ""Y"" to display all "_UNITS

 +3        SET INHLP=INHLP_", ""N"" to select individual "_UNITS_"."

 +4        SET X=$$YN^UTSRD("Do you wish to print ALL "_UNITS_"? ;0",INHLP)

 +5        IF $PIECE(X,U,2)]""

               SET INEXIT=1

 +6        QUIT X

 +7       ;

COMMON()  ;do you want the common segments?

 +1        NEW INHLP,X

 +2        SET INHLP="Do you want to include the Message Header segment (MSH) "

 +3        SET INHLP=INHLP_"and the Patient ID segment (PID)?"

 +4        SET X=$$YN^UTSRD("Include the COMMON SEGMENTS (MSH and PID)? ;0",INHLP)

 +5        IF $PIECE(X,U,2)]""

               SET INEXIT=1

 +6        QUIT X

 +7       ;

INPERR()  ;do you want to print any lookup errors?

 +1        NEW INHLP

 +2        SET INHLP="Lists non-existant CHCS fields and multiply defined HL7 Message Segments"

 +3        SET X=$$YN^UTSRD("Print ""Lookup Errors"" listing? ;0",INHLP)

 +4        IF $PIECE(X,U,2)]""

               SET INEXIT=1

 +5        QUIT X

 +6       ;

TABOUT()  ;set up the output for exporting as a tab-delimited file?

 +1        NEW INHLP,X

 +2        SET INHLP="A tab-delimited VMS file can be easily imported into desk-top applications."

 +3        SET X=$$YN^UTSRD("Do you want this file to be tab-delimited? ;0",INHLP)

 +4        IF $PIECE(X,U,2)]""

               SET INEXIT=1

 +5        QUIT X

 +6       ;