- INHMGD1 ;CAR; 15 May 97 12:22;HL7 MESSAGING - MANAGEMENT OF DATA SOURCES
- ;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
- ;COPYRIGHT 1991-2000 SAIC
- ;
- ; MODULE NAME:
- ; HL7 Messaging - Data Source Display and Validation
- ; Handle Field (INHMGD1).
- ;
- ; PURPOSE:
- ; Module INHMGD1 is used to extract information describing the
- ; source file and field for HL7 Messaging segment fields.
- ;
- IN(INDA,INP) ;Entere here with INDA= ien of message to process one message.
- ; Input:
- ; INDA = Internal Entry Number (IEN) of message
- ; INP = Flag, +INP>0 means create tab-delimited output,
- ; for exporting to desk-top applications, like MS-Access.
- ; Also, $E(INP,2,999) contains tab delimited Message and
- ; Segment information. Will be copied to INPDATA for printing.
- ;
- Q:'INDA
- N INMSG S INMSG=INDA
- ;Get message zero node, root#, and the root# & global name
- S INMSG(0)=$G(^INTHL7M(INMSG,0)) Q:INMSG(0)=""
- ;Quit on Inactive Message, if called from INALL
- I INALL=1 Q:$P(INMSG(0),U,8)
- ;
- N FIELD,FILE,FLVL,INHF2,IDENT,INAUDIT
- N INDB,INDTY,INEX,INDATA,INS,INSEQ,INSEG,INSG,INSYS
- N INX,INREPEAT,INREQ
- N INSVAR,TAB
- ;
- ;Initializations: NOTE: many of the following lines were copied
- ;from the input script generator routine, INHSGZ2.
- S (FLVL,IDENT,INREPEAT)=0
- ; FILE = Root file number from piece 5 of INMSG(0)
- ; FILE(0) = (Root file number)^^(Global Name)
- S FILE=+$P(INMSG(0),U,5) Q:'FILE
- Q:'$D(^DIC(+FILE,0,"GL")) S FILE(0)=FILE_U_^("GL")
- ;
- ;initialize abbreviated data listing
- S TAB=$C(9)
- S INP=$G(INP,0) I INP S INP="1"_$P(INMSG(0),U) ;$P 1
- ;
- ;You don't really need INSYS and INAUDIT, but it can't hurt.
- S INSYS=$$SC^INHUTIL1,INAUDIT=0
- S INEXIT=0
- ;
- ;BEGIN OUTPUT:
- ;Display header page(s) for this message
- D HSET ;setup 3 line header
- D PAGE1^INHMGD11(INMSG,INMSG(0),.INHDR)
- ;
- S INTRP=$G(^INTHL7M(INMSG,"S")) ;get script pointers
- S INMODE=$S($P(INTRP,U,2):1,1:0) ;incoming (0) or outgoing (1) message
- S INPARS=$S($P(INMSG(0),U,7)="P":1,1:0) ;is parse only set
- S INAM=$P(INMSG(0),U) ;the name of this message
- ;
- ;Order through the segments for this message using the "AS" x-ref.
- S INSEQ=""
- F S INSEQ=$O(^INTHL7M(INMSG,1,"AS",INSEQ)) Q:'INSEQ!INEXIT D
- .S INX=0
- .F S INX=$O(^INTHL7M(INMSG,1,"AS",INSEQ,INX)) Q:'INX!INEXIT D
- ..S INSEG(1)=^INTHL7M(INMSG,1,INX,0)
- ..;skip parent segments, they will be called recursively from SEG^
- ..I '$P(INSEG(1),U,11) D SEG^INHMGD2(INX,.FLVL,.FILE,.INP,.INERN)
- Q
- ;
- DASH(QTY,CH) ;Extrensic. Creates QTY copies of CH
- ; Inputs:
- ; QTY = numeric integer, how many copies of CH do you want in the
- ; output string.
- ; CH = character you want repeated. defaults to "-", hence the
- ; name DASH, but " " or anything else is ok.
- ; Output:
- ;
- N DASH S CH=$G(CH,"-"),$P(DASH,CH,QTY+1)=""
- Q DASH
- ;
- HSET ;set up header
- ; No Parameters.
- ; Description: The function HSET is used to set up the header with
- ; the current page and current date/time.
- ; Return:
- ; globally creates the INHDR array, containing quoted DATA strings
- ; for use by WRITE^INHMGD1.
- ;
- ; Code Begins:
- S INHDR(1)="""HL7 Messaging Data Source"",?(IOM-30+ING),INDT,?(IOM-10+ING),""Page: "",INPAGE"
- S INHDR(2)="""Message: "",INAM"
- S INHDR(3)=""""_$$DASH(78+INOFF)_""""
- Q
- ;
- ; No Parameters.
- ; Description: The function HEADER is used to display the header
- ; when reaching the end of the page/screen, and give
- ; the user the option to continue or to abort.
- ;
- N INA,X
- Q:$L($G(INP))>1
- Q:INEXIT
- ; Check for end of page/screen and give option to continue or quit
- I $E(IOST)="C",'$D(IO("Q")),IO=IO(0),INPAGE D
- .;
- .I $Y+2<IOSL F X=$S(IOSL>24:1,1:$Y):1:$S(IOSL>24:4,1:21) W !
- .Q:$Y+9<IOSL
- .S INEXIT=$$CR^UTSRD
- I INEXIT W @IOF Q
- ;Display new page and header
- S INPAGE=INPAGE+1 W @IOF
- S INA=0 F S INA=$O(INHDR(INA)) Q:'INA W !,?ING,@INHDR(INA)
- S INHF2=$G(INHF2)
- S:INHF2=-1 INHF2=0
- D:INHF2 HDR2
- Q
- ;
- HDR2 ;Header 2
- ; No Parameters.
- ; Output:
- ; generates a DATA line for writing by WRITE^INHMGD1, with the
- ; segment column labels. Used after the segment header and on each
- ; page after the page header.
- ; 12,"-" CHCS 11,"-"
- N DATA,X,X1
- ;
- S X=$S(INOFF:INOFF-11,1:0)
- S DATA="?0,"" R R L X"""
- S DATA=DATA_",?INS2-1,""------------ CHCS "",$$DASH((X)+14)"
- D WRITE
- S DATA="?0,""Seq# Len DT q p k f GIS Field Name"""
- S DATA=DATA_",?INS2-1,""Field#:File """
- I IOM<96 S DATA=DATA_",""(Field Name)"""
- I IOM'<96 S DATA=DATA_","" (Field Name)"""
- D WRITE
- S DATA=""""_$$DASH(78+INOFF)_"""" D WRITE
- S INHF2=0 ;means don't rewrite header
- Q
- ;
- WRITE ;output a line
- ; Input:
- ; DATA = passed globally, is a quoted line for use with W @DATA
- ;
- Q:INEXIT
- Q:INP
- I $Y>(IOSL-3) D HEADER
- W !,?ING,@DATA S DATA=""
- Q
- ;
- YN(INV,INN) ;Extrensic. Converts "" and 0 to NO and 1 to YES
- ; Inputs:
- ; INV = the value ["",0,1] to be converted to YES/NO or Y/N
- ; INN = control: 1 for "YES"/"NO", 0 for "Y"/"N"
- ;
- Q $E($S(INV="1":"YES",INV="0":"NO",1:INV),1,$S($G(INN):3,1:1))
- ;
- LKPRM(INX) ;Extrensic. Converts lookup parameter F,L,N,O & P to long form
- Q $S(INX="F":"FORCED LAYGO",INX="L":"LAYGO ALLOWED",INX="N":"NO LAYGO",INX="O":"LOOKUP ONLY",INX="P":"PARSE ONLY",1:INX)
- ;
- INHMGD1 ;CAR; 15 May 97 12:22;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:
- +5 ; HL7 Messaging - Data Source Display and Validation
- +6 ; Handle Field (INHMGD1).
- +7 ;
- +8 ; PURPOSE:
- +9 ; Module INHMGD1 is used to extract information describing the
- +10 ; source file and field for HL7 Messaging segment fields.
- +11 ;
- IN(INDA,INP) ;Entere here with INDA= ien of message to process one message.
- +1 ; Input:
- +2 ; INDA = Internal Entry Number (IEN) of message
- +3 ; INP = Flag, +INP>0 means create tab-delimited output,
- +4 ; for exporting to desk-top applications, like MS-Access.
- +5 ; Also, $E(INP,2,999) contains tab delimited Message and
- +6 ; Segment information. Will be copied to INPDATA for printing.
- +7 ;
- +8 IF 'INDA
- QUIT
- +9 NEW INMSG
- SET INMSG=INDA
- +10 ;Get message zero node, root#, and the root# & global name
- +11 SET INMSG(0)=$GET(^INTHL7M(INMSG,0))
- IF INMSG(0)=""
- QUIT
- +12 ;Quit on Inactive Message, if called from INALL
- +13 IF INALL=1
- IF $PIECE(INMSG(0),U,8)
- QUIT
- +14 ;
- +15 NEW FIELD,FILE,FLVL,INHF2,IDENT,INAUDIT
- +16 NEW INDB,INDTY,INEX,INDATA,INS,INSEQ,INSEG,INSG,INSYS
- +17 NEW INX,INREPEAT,INREQ
- +18 NEW INSVAR,TAB
- +19 ;
- +20 ;Initializations: NOTE: many of the following lines were copied
- +21 ;from the input script generator routine, INHSGZ2.
- +22 SET (FLVL,IDENT,INREPEAT)=0
- +23 ; FILE = Root file number from piece 5 of INMSG(0)
- +24 ; FILE(0) = (Root file number)^^(Global Name)
- +25 SET FILE=+$PIECE(INMSG(0),U,5)
- IF 'FILE
- QUIT
- +26 IF '$DATA(^DIC(+FILE,0,"GL"))
- QUIT
- SET FILE(0)=FILE_U_^("GL")
- +27 ;
- +28 ;initialize abbreviated data listing
- +29 SET TAB=$CHAR(9)
- +30 ;$P 1
- SET INP=$GET(INP,0)
- IF INP
- SET INP="1"_$PIECE(INMSG(0),U)
- +31 ;
- +32 ;You don't really need INSYS and INAUDIT, but it can't hurt.
- +33 SET INSYS=$$SC^INHUTIL1
- SET INAUDIT=0
- +34 SET INEXIT=0
- +35 ;
- +36 ;BEGIN OUTPUT:
- +37 ;Display header page(s) for this message
- +38 ;setup 3 line header
- DO HSET
- +39 DO PAGE1^INHMGD11(INMSG,INMSG(0),.INHDR)
- +40 ;
- +41 ;get script pointers
- SET INTRP=$GET(^INTHL7M(INMSG,"S"))
- +42 ;incoming (0) or outgoing (1) message
- SET INMODE=$SELECT($PIECE(INTRP,U,2):1,1:0)
- +43 ;is parse only set
- SET INPARS=$SELECT($PIECE(INMSG(0),U,7)="P":1,1:0)
- +44 ;the name of this message
- SET INAM=$PIECE(INMSG(0),U)
- +45 ;
- +46 ;Order through the segments for this message using the "AS" x-ref.
- +47 SET INSEQ=""
- +48 FOR
- SET INSEQ=$ORDER(^INTHL7M(INMSG,1,"AS",INSEQ))
- IF 'INSEQ!INEXIT
- QUIT
- Begin DoDot:1
- +49 SET INX=0
- +50 FOR
- SET INX=$ORDER(^INTHL7M(INMSG,1,"AS",INSEQ,INX))
- IF 'INX!INEXIT
- QUIT
- Begin DoDot:2
- +51 SET INSEG(1)=^INTHL7M(INMSG,1,INX,0)
- +52 ;skip parent segments, they will be called recursively from SEG^
- +53 IF '$PIECE(INSEG(1),U,11)
- DO SEG^INHMGD2(INX,.FLVL,.FILE,.INP,.INERN)
- End DoDot:2
- End DoDot:1
- +54 QUIT
- +55 ;
- DASH(QTY,CH) ;Extrensic. Creates QTY copies of CH
- +1 ; Inputs:
- +2 ; QTY = numeric integer, how many copies of CH do you want in the
- +3 ; output string.
- +4 ; CH = character you want repeated. defaults to "-", hence the
- +5 ; name DASH, but " " or anything else is ok.
- +6 ; Output:
- +7 ;
- +8 NEW DASH
- SET CH=$GET(CH,"-")
- SET $PIECE(DASH,CH,QTY+1)=""
- +9 QUIT DASH
- +10 ;
- HSET ;set up header
- +1 ; No Parameters.
- +2 ; Description: The function HSET is used to set up the header with
- +3 ; the current page and current date/time.
- +4 ; Return:
- +5 ; globally creates the INHDR array, containing quoted DATA strings
- +6 ; for use by WRITE^INHMGD1.
- +7 ;
- +8 ; Code Begins:
- +9 SET INHDR(1)="""HL7 Messaging Data Source"",?(IOM-30+ING),INDT,?(IOM-10+ING),""Page: "",INPAGE"
- +10 SET INHDR(2)="""Message: "",INAM"
- +11 SET INHDR(3)=""""_$$DASH(78+INOFF)_""""
- +12 QUIT
- +13 ;
- +1 ; No Parameters.
- +2 ; Description: The function HEADER is used to display the header
- +3 ; when reaching the end of the page/screen, and give
- +4 ; the user the option to continue or to abort.
- +5 ;
- +6 NEW INA,X
- +7 IF $LENGTH($GET(INP))>1
- QUIT
- +8 IF INEXIT
- QUIT
- +9 ; Check for end of page/screen and give option to continue or quit
- +10 IF $EXTRACT(IOST)="C"
- IF '$DATA(IO("Q"))
- IF IO=IO(0)
- IF INPAGE
- Begin DoDot:1
- +11 ;
- +12 IF $Y+2<IOSL
- FOR X=$SELECT(IOSL>24:1,1:$Y):1:$SELECT(IOSL>24:4,1:21)
- WRITE !
- +13 IF $Y+9<IOSL
- QUIT
- +14 SET INEXIT=$$CR^UTSRD
- End DoDot:1
- +15 IF INEXIT
- WRITE @IOF
- QUIT
- +16 ;Display new page and header
- +17 SET INPAGE=INPAGE+1
- WRITE @IOF
- +18 SET INA=0
- FOR
- SET INA=$ORDER(INHDR(INA))
- IF 'INA
- QUIT
- WRITE !,?ING,@INHDR(INA)
- +19 SET INHF2=$GET(INHF2)
- +20 IF INHF2=-1
- SET INHF2=0
- +21 IF INHF2
- DO HDR2
- +22 QUIT
- +23 ;
- HDR2 ;Header 2
- +1 ; No Parameters.
- +2 ; Output:
- +3 ; generates a DATA line for writing by WRITE^INHMGD1, with the
- +4 ; segment column labels. Used after the segment header and on each
- +5 ; page after the page header.
- +6 ; 12,"-" CHCS 11,"-"
- +7 NEW DATA,X,X1
- +8 ;
- +9 SET X=$SELECT(INOFF:INOFF-11,1:0)
- +10 SET DATA="?0,"" R R L X"""
- +11 SET DATA=DATA_",?INS2-1,""------------ CHCS "",$$DASH((X)+14)"
- +12 DO WRITE
- +13 SET DATA="?0,""Seq# Len DT q p k f GIS Field Name"""
- +14 SET DATA=DATA_",?INS2-1,""Field#:File """
- +15 IF IOM<96
- SET DATA=DATA_",""(Field Name)"""
- +16 IF IOM'<96
- SET DATA=DATA_","" (Field Name)"""
- +17 DO WRITE
- +18 SET DATA=""""_$$DASH(78+INOFF)_""""
- DO WRITE
- +19 ;means don't rewrite header
- SET INHF2=0
- +20 QUIT
- +21 ;
- WRITE ;output a line
- +1 ; Input:
- +2 ; DATA = passed globally, is a quoted line for use with W @DATA
- +3 ;
- +4 IF INEXIT
- QUIT
- +5 IF INP
- QUIT
- +6 IF $Y>(IOSL-3)
- DO HEADER
- +7 WRITE !,?ING,@DATA
- SET DATA=""
- +8 QUIT
- +9 ;
- YN(INV,INN) ;Extrensic. Converts "" and 0 to NO and 1 to YES
- +1 ; Inputs:
- +2 ; INV = the value ["",0,1] to be converted to YES/NO or Y/N
- +3 ; INN = control: 1 for "YES"/"NO", 0 for "Y"/"N"
- +4 ;
- +5 QUIT $EXTRACT($SELECT(INV="1":"YES",INV="0":"NO",1:INV),1,$SELECT($GET(INN):3,1:1))
- +6 ;
- LKPRM(INX) ;Extrensic. Converts lookup parameter F,L,N,O & P to long form
- +1 QUIT $SELECT(INX="F":"FORCED LAYGO",INX="L":"LAYGO ALLOWED",INX="N":"NO LAYGO",INX="O":"LOOKUP ONLY",INX="P":"PARSE ONLY",1:INX)
- +2 ;