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 ;
