INHMGD4 ;CAR; 17 Sep 97 11:45;HL7 MESSAGING - MAIN DATA PRINTING ROUTINE
;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
;COPYRIGHT 1991-2000 SAIC
;
; MODULE NAME:
; HL7 Messaging - Main Data Printing Module (INHMGD4).
;
; PURPOSE:
; Collect previously stored data and display on chosen medium.
;
PRINT(INDL,INP) ;Print Routine
; Inputs:
; INDL = Data Loacation in the form "field#:file# (field name)"
; INP = Flag and Description Array for MS Access output.
;
N INS1,INS3,INW1,INW3,INJ,INK,INEED,INAVL
N INSV,INFN,INFLD,INFIL,INAME,INTXT,INDSC
;
;determine column starting positions based of width of page (IOM)
S INS1=$S(INDENT:25,1:23)+ING ;start of column1
; INS2 is defined in INHMGD1
S INW1=INS2-INS1+1-3 ;width of column1
S INS3=INS2+$S(IOM<96:12,1:16) ;start of column3
S INW3=IOM-INS3+1-4 ;width of column3
;
;BEGIN creating DATA line for output by WRITE^INHMGD1
;add segment ID#
S INSV=$E(INSVAR,4,7),INSV=$P(INSV,".",2) S:$L(INSV) INSV="."_INSV
S DATA="$J(INFD(""SQ""),3)_INSV" ;sequence# and segment ID#
;
S DATA=DATA_",?ING+6,$J(INFD(""LEN""),3)" ;Field Length
S DATA=DATA_",?ING+11,INFD(""DT"")" ;Data Type abbreviation
S DATA=DATA_",?ING+15,INREQ,?ING+17,INREP,?ING+19,INUFL,?ING+21,XFM" ;required, repeating...
;
;add the HL7 field name to DATA
S DATA=DATA_",?INS1"
D WRAPS^INHMGD11(INFD("FN"),.INFN,INW1)
S DATA=DATA_",INFN(1)"
;
;check for results from DICOMP lookup, INFIL is File, INFLD is Field
S (INFLD,INFIL,INAME)=""
;for @ & "", stick contents in INAME so it will appear in 3rd CHCS col.
I $E(INDL)=""""!($E(INDL)="@") S INAME=INDL,INDL=""
;line looks like "4:44.8 (FIELD NAME)", so double $P for INFIL
I $L(INDL) S INFLD=$P(INDL,":"),INFIL=$P($P(INDL," "),":",2)
;$L(INDL) means we have field#[:file#], need to split out field name
I $L(INDL),'$L(INAME) S INAME=$S(INDL["(":"("_$P(INDL,"(",2,9),1:"")
;
;no need to wrap the HL7 field name if there is no Fileman Field#
I 'INFLD,INFN>1 S DATA=DATA_",INFN(2)",INFN=1
;
;add field# to DATA, add ":", add file#
I $L(INFLD) S DATA=DATA_",?INS2,$J(INFLD,5)"
I +INFIL S INFIL=INFIL_" ",DATA=DATA_","":"",?(INS2+6),INFIL"
;
;add field name to DATA
S INAME=$G(INAME)
D WRAPS^INHMGD11(INAME,.INTXT,INW3)
S DATA=DATA_",?INS3,INTXT(1)"
Q:INEXIT
;
;before we write out the data line, see if it all will fit on the
;existing page, or if we need a new page.
S INJ=INFN S:INTXT>INJ INJ=INTXT S INEED=1+(INJ-1) ;1 line+wraps
S INAVL=IOSL-$Y-2
I INEED>INAVL D HEADER^INHMGD1
;WRITE the DATA line
D WRITE^INHMGD1
;
;write out the wrapped HL7 Field Name and wrapped Fileman Field Name
S:'INFLD INFN(2)=""
I INJ>1 F INK=2:1:INJ D
.S DATA="?INS1,$G(INFN(INK)),?INS3,$G(INTXT(INK))"
.D WRITE^INHMGD1
;
;process data for output file
I INP,'INDENT D ;'INDENT because RQMTS doesn't want sub fields
.;add field length & Data Type
.S INP=INP_TAB_INFD("LEN") ; $P10 Field Length
.S INP=INP_TAB_INFD("DT") ; $P11 Field Data Type
.S INP=INP_TAB_$S(INREQ["Y":"Y",1:"") ;$P12 Field Required?
.S INP=INP_TAB_$S(INREP["Y":"Y",1:"") ;$P13 Field Repeatable?
.S INP=INP_TAB_INFD("FN") ; $P14 HL7 Field Name
.S INP=INP_TAB_INFLD ; $P15 Fileman Field#
.S INP=INP_TAB_INFIL ; $P16 Fileman File#
.S INP=INP_TAB_INAME ; $P17 Fileman Field Name
.;add an incrementing line # to front of DATA line
.S X=+INP,INP=$E(INP,$L(X)+1,254)
.S DATA="X+.1_TAB_INP" ;Line type: (data=.1, description=>.2)
.D WRITE^INHMGD1
.;restore the numbering to the front of INP
.S INP=X+1_INP
Q
;
MAPXFRM(INFLDC) ;
;Print out any Map functions or Xfrms
N DATA,INDATA,INTXT,J
I $L($G(INFLDC(4))) D S INFLDC(4)=""
.D WRAPS^INHMGD11(INFLDC(4),.INTXT,IOM-29)
.S DATA="?10,""Incoming Xform: """,J=0
.F S J=$O(INTXT(J)) Q:'J D
..S DATA=DATA_",INTXT(J)" D WRITE^INHMGD1 S DATA="?26"
;
I $L($G(INFLDC(5))) D S INFLDC(5)=""
.D WRAPS^INHMGD11(INFLDC(5),.INTXT,IOM-29)
.S DATA="?10,""Outgoing Xform: """,J=0
.F S J=$O(INTXT(J)) Q:'J D
..S DATA=DATA_",INTXT(J)" D WRITE^INHMGD1 S DATA="?26"
;
I $G(INFLDC(50)) D S INFLDC(50)=""
.S INDATA=$P($G(^INVD(4090.2,+INFLDC(50),0)),U)
.I $L(INDATA) S DATA="?10,""Map Function: "",INDATA" D WRITE^INHMGD1
S DATA="$C(32)"
Q
;
INHMGD4 ;CAR; 17 Sep 97 11:45;HL7 MESSAGING - MAIN DATA PRINTING ROUTINE
+1 ;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
+2 ;COPYRIGHT 1991-2000 SAIC
+3 ;
+4 ; MODULE NAME:
+5 ; HL7 Messaging - Main Data Printing Module (INHMGD4).
+6 ;
+7 ; PURPOSE:
+8 ; Collect previously stored data and display on chosen medium.
+9 ;
PRINT(INDL,INP) ;Print Routine
+1 ; Inputs:
+2 ; INDL = Data Loacation in the form "field#:file# (field name)"
+3 ; INP = Flag and Description Array for MS Access output.
+4 ;
+5 NEW INS1,INS3,INW1,INW3,INJ,INK,INEED,INAVL
+6 NEW INSV,INFN,INFLD,INFIL,INAME,INTXT,INDSC
+7 ;
+8 ;determine column starting positions based of width of page (IOM)
+9 ;start of column1
SET INS1=$SELECT(INDENT:25,1:23)+ING
+10 ; INS2 is defined in INHMGD1
+11 ;width of column1
SET INW1=INS2-INS1+1-3
+12 ;start of column3
SET INS3=INS2+$SELECT(IOM<96:12,1:16)
+13 ;width of column3
SET INW3=IOM-INS3+1-4
+14 ;
+15 ;BEGIN creating DATA line for output by WRITE^INHMGD1
+16 ;add segment ID#
+17 SET INSV=$EXTRACT(INSVAR,4,7)
SET INSV=$PIECE(INSV,".",2)
IF $LENGTH(INSV)
SET INSV="."_INSV
+18 ;sequence# and segment ID#
SET DATA="$J(INFD(""SQ""),3)_INSV"
+19 ;
+20 ;Field Length
SET DATA=DATA_",?ING+6,$J(INFD(""LEN""),3)"
+21 ;Data Type abbreviation
SET DATA=DATA_",?ING+11,INFD(""DT"")"
+22 ;required, repeating...
SET DATA=DATA_",?ING+15,INREQ,?ING+17,INREP,?ING+19,INUFL,?ING+21,XFM"
+23 ;
+24 ;add the HL7 field name to DATA
+25 SET DATA=DATA_",?INS1"
+26 DO WRAPS^INHMGD11(INFD("FN"),.INFN,INW1)
+27 SET DATA=DATA_",INFN(1)"
+28 ;
+29 ;check for results from DICOMP lookup, INFIL is File, INFLD is Field
+30 SET (INFLD,INFIL,INAME)=""
+31 ;for @ & "", stick contents in INAME so it will appear in 3rd CHCS col.
+32 IF $EXTRACT(INDL)=""""!($EXTRACT(INDL)="@")
SET INAME=INDL
SET INDL=""
+33 ;line looks like "4:44.8 (FIELD NAME)", so double $P for INFIL
+34 IF $LENGTH(INDL)
SET INFLD=$PIECE(INDL,":")
SET INFIL=$PIECE($PIECE(INDL," "),":",2)
+35 ;$L(INDL) means we have field#[:file#], need to split out field name
+36 IF $LENGTH(INDL)
IF '$LENGTH(INAME)
SET INAME=$SELECT(INDL["(":"("_$PIECE(INDL,"(",2,9),1:"")
+37 ;
+38 ;no need to wrap the HL7 field name if there is no Fileman Field#
+39 IF 'INFLD
IF INFN>1
SET DATA=DATA_",INFN(2)"
SET INFN=1
+40 ;
+41 ;add field# to DATA, add ":", add file#
+42 IF $LENGTH(INFLD)
SET DATA=DATA_",?INS2,$J(INFLD,5)"
+43 IF +INFIL
SET INFIL=INFIL_" "
SET DATA=DATA_","":"",?(INS2+6),INFIL"
+44 ;
+45 ;add field name to DATA
+46 SET INAME=$GET(INAME)
+47 DO WRAPS^INHMGD11(INAME,.INTXT,INW3)
+48 SET DATA=DATA_",?INS3,INTXT(1)"
+49 IF INEXIT
QUIT
+50 ;
+51 ;before we write out the data line, see if it all will fit on the
+52 ;existing page, or if we need a new page.
+53 ;1 line+wraps
SET INJ=INFN
IF INTXT>INJ
SET INJ=INTXT
SET INEED=1+(INJ-1)
+54 SET INAVL=IOSL-$Y-2
+55 IF INEED>INAVL
DO HEADER^INHMGD1
+56 ;WRITE the DATA line
+57 DO WRITE^INHMGD1
+58 ;
+59 ;write out the wrapped HL7 Field Name and wrapped Fileman Field Name
+60 IF 'INFLD
SET INFN(2)=""
+61 IF INJ>1
FOR INK=2:1:INJ
Begin DoDot:1
+62 SET DATA="?INS1,$G(INFN(INK)),?INS3,$G(INTXT(INK))"
+63 DO WRITE^INHMGD1
End DoDot:1
+64 ;
+65 ;process data for output file
+66 ;'INDENT because RQMTS doesn't want sub fields
IF INP
IF 'INDENT
Begin DoDot:1
+67 ;add field length & Data Type
+68 ; $P10 Field Length
SET INP=INP_TAB_INFD("LEN")
+69 ; $P11 Field Data Type
SET INP=INP_TAB_INFD("DT")
+70 ;$P12 Field Required?
SET INP=INP_TAB_$SELECT(INREQ["Y":"Y",1:"")
+71 ;$P13 Field Repeatable?
SET INP=INP_TAB_$SELECT(INREP["Y":"Y",1:"")
+72 ; $P14 HL7 Field Name
SET INP=INP_TAB_INFD("FN")
+73 ; $P15 Fileman Field#
SET INP=INP_TAB_INFLD
+74 ; $P16 Fileman File#
SET INP=INP_TAB_INFIL
+75 ; $P17 Fileman Field Name
SET INP=INP_TAB_INAME
+76 ;add an incrementing line # to front of DATA line
+77 SET X=+INP
SET INP=$EXTRACT(INP,$LENGTH(X)+1,254)
+78 ;Line type: (data=.1, description=>.2)
SET DATA="X+.1_TAB_INP"
+79 DO WRITE^INHMGD1
+80 ;restore the numbering to the front of INP
+81 SET INP=X+1_INP
End DoDot:1
+82 QUIT
+83 ;
MAPXFRM(INFLDC) ;
+1 ;Print out any Map functions or Xfrms
+2 NEW DATA,INDATA,INTXT,J
+3 IF $LENGTH($GET(INFLDC(4)))
Begin DoDot:1
+4 DO WRAPS^INHMGD11(INFLDC(4),.INTXT,IOM-29)
+5 SET DATA="?10,""Incoming Xform: """
SET J=0
+6 FOR
SET J=$ORDER(INTXT(J))
IF 'J
QUIT
Begin DoDot:2
+7 SET DATA=DATA_",INTXT(J)"
DO WRITE^INHMGD1
SET DATA="?26"
End DoDot:2
End DoDot:1
SET INFLDC(4)=""
+8 ;
+9 IF $LENGTH($GET(INFLDC(5)))
Begin DoDot:1
+10 DO WRAPS^INHMGD11(INFLDC(5),.INTXT,IOM-29)
+11 SET DATA="?10,""Outgoing Xform: """
SET J=0
+12 FOR
SET J=$ORDER(INTXT(J))
IF 'J
QUIT
Begin DoDot:2
+13 SET DATA=DATA_",INTXT(J)"
DO WRITE^INHMGD1
SET DATA="?26"
End DoDot:2
End DoDot:1
SET INFLDC(5)=""
+14 ;
+15 IF $GET(INFLDC(50))
Begin DoDot:1
+16 SET INDATA=$PIECE($GET(^INVD(4090.2,+INFLDC(50),0)),U)
+17 IF $LENGTH(INDATA)
SET DATA="?10,""Map Function: "",INDATA"
DO WRITE^INHMGD1
End DoDot:1
SET INFLDC(50)=""
+18 SET DATA="$C(32)"
+19 QUIT
+20 ;
