- INHMG2 ;KN; 18 Jun 99 13:38; Script Message Generator - Extend INHMG1
- ;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
- ;COPYRIGHT 1991-2000 SAIC
- ;
- ; MODULE NAME: Script Message Generator (INHMG2)
- ;
- ; PURPOSE:
- ; The purpose of the module INHMG2 is used as a print template
- ; to display the segments and fields for the selected script
- ; generator message.
- ;
- ; DESCRIPTION:
- ; The processing of the module INHMG2 is used to search the global
- ; ^INTHL7S for the segments, and ^INTHL7F for the fields to get
- ; the details of selected Script Generator Message. Based on
- ; option INCOMSEG from user, it will display or not display the common
- ; segments for the message. Other segments and fields will be
- ; displayed.
- ;
- ;
- INFIELD(INSG,D0,D1,INCOMSEG) ; Entry point
- ;
- ; Description: INFIELD is the entry point for module INHMG2. It will
- ; array INSG of segment information, get the data for
- ; all the fields in the current segment, and display.
- ;
- ; Return: None
- ; Parameter:
- ; Input INSG : array contains the information for current segment
- ; D0 : IEN
- ; D1 : IEN of multiple
- ;
- ; Return: None
- ;
- ; Code begins
- N SP,FP,SQ,RQ,RP,LK,XF,FN,LOC,LEN,D2,D3,I,OIT,INV,INT,OUT,MP,DT,INTMP
- S SP=$P(^INTHL7M(D0,1,D1,0),U,1),D2=0 Q:'SP Q:$G(DUOUT)
- ; Sort by sequence number by storing it (ID2) in INTMP array
- S ID2=0
- F S ID2=$O(^INTHL7S(SP,1,ID2)) Q:'ID2 Q:$G(DUOUT) D
- .S INSQ=^INTHL7S(SP,1,ID2,0),SQ=+$P(INSQ,U,2),FP=+$P(INSQ,U,1)
- .; Only store in INTMP if the field pointed by FP is defined
- .I $D(^INTHL7F(FP,0)) S INTMP(SQ,ID2)=""
- ; Retrieve sequence number in order and get all related info for display
- S INT1="INTMP"
- F S INT1=$Q(@INT1) Q:'$L(INT1) Q:$G(DUOUT) D
- .S ID1=$$QS^INHUTIL(INT1,1),D2=$$QS^INHUTIL(INT1,2),SQ=^INTHL7S(SP,1,D2,0),FP=$P(SQ,U,1),RQ=$P(SQ,U,3),RP=$P(SQ,U,4),LK=$P(SQ,U,5),XF=$P(SQ,U,6),INFD(ID1,"SQ")=$P(SQ,U,2),D3=0 Q:$G(DUOUT) D:FP
- ..F I="RQ","RP","LK","XF" S @I=$S(@I=1:"Y",@I=0:"N",1:"")
- ..S INFD(ID1,"SQ","RQ")=$G(RQ),INFD(ID1,"SQ","RP")=$G(RP),INFD(ID1,"SQ","LK")=$G(LK),INFD(ID1,"SQ","XF")=$G(XF)
- ..S LEN=$G(^INTHL7F(FP,0)),INFD(ID1,"INV")=$G(^("I")),INFD(ID1,"INT")=$G(^(4)),INFD(ID1,"OUT")=$G(^(5)),INFD(ID1,"SQ","IDL")=$G(^("C")),MP=$P($G(^(50)),"^",1) S:MP INFD(ID1,"MP")=$P($G(^INVD(4090.2,MP,0)),"^",1)
- ..S DT=$P(LEN,U,2) S INFD(ID1,"SQ","DT")=$P($G(^INTHL7FT(DT,0)),U,2)
- ..S INFD(ID1,"OIT")=$P(LEN,U,5),INFD(ID1,"SQ","FN")=$P(LEN,U,1),INFD(ID1,"SQ","LEN")=$P(LEN,U,3)
- ; INCT is the total lines displayed in the next page
- ; calculate how many field
- S (INCT,INSLN,INFLN)=0
- ; INSLN is the number of the lines in segment display
- S INX="" F S INX=$O(INSG(INX)) Q:INX="" D
- .S:$G(INSG(INX))'="" INSLN=$G(INSLN)+1
- ; INFLN is the number of the lines in field display
- S INX="" F S INX=$O(INFD(INX)) Q:INX="" D
- .S INY="" F S INY=$O(INFD(INX,INY)) Q:INY="" D
- ..S:$G(INFD(INX,INY))'="" INFLN=$G(INFLN)+1
- ; Calculate total number of the lines
- S:INFLN>0 INCT=$G(INSLN)+2+$G(INFLN)+1
- S:INFLN=0 INCT=$G(INSLN)+1
- I ($Y+INCT)'>(IOSL-4) W !
- I ($Y+INCT)>(IOSL-4) D HEADER^INHMG
- S HF2=1
- ; Display for the segment name and the ID
- N NL S NL=1 D T,N Q:$G(DUOUT) W "=====Segment Name==================================ID=====Seq No==Req==Rep==OF=="
- D N Q:$G(DUOUT) W ?0,$G(INSG("NM"))
- W ?51,$G(INSG("NM",1))
- D N:$X>58 Q:$G(DUOUT) W ?58,$J($G(INSG("NM",2)),0,1)
- W ?66,$G(INSG("NM",3))
- W ?71,$G(INSG("NM",4))
- W ?76,$G(INSG("NM",5))
- I $G(INSG("PS"))'="" D T,N Q:$G(DUOUT) W ?8,"Parent Segment:",?24,INSG("PS")
- I $G(INSG("FL"))'="" D N Q:$G(DUOUT) W ?18,"File:",?24,INSG("FL")
- I $G(INSG("MF"))'="" D N Q:$G(DUOUT) W ?8,"Multiple Field:",?24,INSG("MF")
- I $G(INSG("UD"))'="" D N Q:$G(DUOUT) W ?4,"User-Defined Index:",?24,INSG("UD")
- I $G(INSG("LP"))'="" D N Q:$G(DUOUT) W ?6,"Lookup Parameter:",?24,INSG("LP")
- I $G(INSG("ML"))'="" D N Q:$G(DUOUT) W ?12,"Make Links:",?24,INSG("ML")
- I $G(INSG("TP"))'="" D N Q:$G(DUOUT) W ?14,"Template:",?24,INSG("TP")
- I $G(INSG("RT"))'="" D N Q:$G(DUOUT) W ?15,"Routine:" W ?25,INSG("RT")
- I $G(INSG("IF"))'="" D N Q:$G(DUOUT) W ?14,"ID Field:" W ?25,INSG("IF")
- I $G(INSG("IV"))'="" D N Q:$G(DUOUT) W ?14,"ID Value:" W ?25,INSG("IV")
- ; Display the fields
- ; Display header for each page. Only display field header if there
- ; is field
- I INFLN>0 D HDR2
- ; If there is no field, then just display a bank line
- I INFLN=0 W !
- ; Initialize INT1, set flag HF2 for field header
- S INT1="",HF2=0
- F S INT1=$O(INFD(INT1)) Q:INT1="" Q:$G(DUOUT) D
- .D T Q:$G(DUOUT) W !,$$JUST^UTIL(INFD(INT1,"SQ"),3,"R",0),?6,$$JUST^UTIL(INFD(INT1,"SQ","LEN"),3,"R",0),?11,INFD(INT1,"SQ","DT"),?15,INFD(INT1,"SQ","RQ"),?17,INFD(INT1,"SQ","RP")
- .W ?19,INFD(INT1,"SQ","LK"),?21,INFD(INT1,"SQ","XF"),?24,INFD(INT1,"SQ","FN")
- .S IDL=$G(INFD(INT1,"SQ","IDL"))
- .; Truncate display for the Data Location, if the character is too long
- .I $L(IDL)<(IOM-56) W ?56,IDL
- .I $L(IDL)>(IOM-56) W ?56,$E(IDL,1,IOM-56),!?56,$E(IDL,IOM-55,$L(IDL))
- .I INFD(INT1,"OIT")'="" D T Q:$G(DUOUT) W !,?10,"Overide Input Xform: ",INFD(INT1,"OIT") Q
- .I INFD(INT1,"INV")'="" D T Q:$G(DUOUT) W !,?10,"Input Validation: ",INFD(INT1,"INV") Q
- .I INFD(INT1,"INT")'="" D T Q:$G(DUOUT) W !,?10,"Incoming Xform: ",INFD(INT1,"INT") Q
- .I INFD(INT1,"OUT")'="" D T Q:$G(DUOUT) W !,?10,"Outgoing Xform: ",INFD(INT1,"OUT") Q
- .I $G(INFD(INT1,"MP"))'="" D T Q:$G(DUOUT) W !,?10,"Map Function: ",INFD(INT1,"MP") Q
- Q
- N Q:$G(DUOUT) W !
- T ; End of page routine
- I ($Y>(IOSL-4))&(INPAGE>0) D HEADER^INHMG D:'$G(HF2) HDR2 S HF2=1
- Q
- HDR2 ;Header 2
- Q:$G(DUOUT) D N W !?15,"R R L X" D N Q:$G(DUOUT)
- W ?0,"SeqNo Len DT q p k f Field Name Data Location"
- D N Q:$G(DUOUT) W "--------------------------------------------------------------------------------"
- Q
- INHMG2 ;KN; 18 Jun 99 13:38; Script Message Generator - Extend INHMG1
- +1 ;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
- +2 ;COPYRIGHT 1991-2000 SAIC
- +3 ;
- +4 ; MODULE NAME: Script Message Generator (INHMG2)
- +5 ;
- +6 ; PURPOSE:
- +7 ; The purpose of the module INHMG2 is used as a print template
- +8 ; to display the segments and fields for the selected script
- +9 ; generator message.
- +10 ;
- +11 ; DESCRIPTION:
- +12 ; The processing of the module INHMG2 is used to search the global
- +13 ; ^INTHL7S for the segments, and ^INTHL7F for the fields to get
- +14 ; the details of selected Script Generator Message. Based on
- +15 ; option INCOMSEG from user, it will display or not display the common
- +16 ; segments for the message. Other segments and fields will be
- +17 ; displayed.
- +18 ;
- +19 ;
- INFIELD(INSG,D0,D1,INCOMSEG) ; Entry point
- +1 ;
- +2 ; Description: INFIELD is the entry point for module INHMG2. It will
- +3 ; array INSG of segment information, get the data for
- +4 ; all the fields in the current segment, and display.
- +5 ;
- +6 ; Return: None
- +7 ; Parameter:
- +8 ; Input INSG : array contains the information for current segment
- +9 ; D0 : IEN
- +10 ; D1 : IEN of multiple
- +11 ;
- +12 ; Return: None
- +13 ;
- +14 ; Code begins
- +15 NEW SP,FP,SQ,RQ,RP,LK,XF,FN,LOC,LEN,D2,D3,I,OIT,INV,INT,OUT,MP,DT,INTMP
- +16 SET SP=$PIECE(^INTHL7M(D0,1,D1,0),U,1)
- SET D2=0
- IF 'SP
- QUIT
- IF $GET(DUOUT)
- QUIT
- +17 ; Sort by sequence number by storing it (ID2) in INTMP array
- +18 SET ID2=0
- +19 FOR
- SET ID2=$ORDER(^INTHL7S(SP,1,ID2))
- IF 'ID2
- QUIT
- IF $GET(DUOUT)
- QUIT
- Begin DoDot:1
- +20 SET INSQ=^INTHL7S(SP,1,ID2,0)
- SET SQ=+$PIECE(INSQ,U,2)
- SET FP=+$PIECE(INSQ,U,1)
- +21 ; Only store in INTMP if the field pointed by FP is defined
- +22 IF $DATA(^INTHL7F(FP,0))
- SET INTMP(SQ,ID2)=""
- End DoDot:1
- +23 ; Retrieve sequence number in order and get all related info for display
- +24 SET INT1="INTMP"
- +25 FOR
- SET INT1=$QUERY(@INT1)
- IF '$LENGTH(INT1)
- QUIT
- IF $GET(DUOUT)
- QUIT
- Begin DoDot:1
- +26 SET ID1=$$QS^INHUTIL(INT1,1)
- SET D2=$$QS^INHUTIL(INT1,2)
- SET SQ=^INTHL7S(SP,1,D2,0)
- SET FP=$PIECE(SQ,U,1)
- SET RQ=$PIECE(SQ,U,3)
- SET RP=$PIECE(SQ,U,4)
- SET LK=$PIECE(SQ,U,5)
- SET XF=$PIECE(SQ,U,6)
- SET INFD(ID1,"SQ")=$PIECE(SQ,U,2)
- SET D3=0
- IF $GET(DUOUT)
- QUIT
- IF FP
- Begin DoDot:2
- +27 FOR I="RQ","RP","LK","XF"
- SET @I=$SELECT(@I=1:"Y",@I=0:"N",1:"")
- +28 SET INFD(ID1,"SQ","RQ")=$GET(RQ)
- SET INFD(ID1,"SQ","RP")=$GET(RP)
- SET INFD(ID1,"SQ","LK")=$GET(LK)
- SET INFD(ID1,"SQ","XF")=$GET(XF)
- +29 SET LEN=$GET(^INTHL7F(FP,0))
- SET INFD(ID1,"INV")=$GET(^("I"))
- SET INFD(ID1,"INT")=$GET(^(4))
- SET INFD(ID1,"OUT")=$GET(^(5))
- SET INFD(ID1,"SQ","IDL")=$GET(^("C"))
- SET MP=$PIECE($GET(^(50)),"^",1)
- IF MP
- SET INFD(ID1,"MP")=$PIECE($GET(^INVD(4090.2,MP,0)),"^",1)
- +30 SET DT=$PIECE(LEN,U,2)
- SET INFD(ID1,"SQ","DT")=$PIECE($GET(^INTHL7FT(DT,0)),U,2)
- +31 SET INFD(ID1,"OIT")=$PIECE(LEN,U,5)
- SET INFD(ID1,"SQ","FN")=$PIECE(LEN,U,1)
- SET INFD(ID1,"SQ","LEN")=$PIECE(LEN,U,3)
- End DoDot:2
- End DoDot:1
- +32 ; INCT is the total lines displayed in the next page
- +33 ; calculate how many field
- +34 SET (INCT,INSLN,INFLN)=0
- +35 ; INSLN is the number of the lines in segment display
- +36 SET INX=""
- FOR
- SET INX=$ORDER(INSG(INX))
- IF INX=""
- QUIT
- Begin DoDot:1
- +37 IF $GET(INSG(INX))'=""
- SET INSLN=$GET(INSLN)+1
- End DoDot:1
- +38 ; INFLN is the number of the lines in field display
- +39 SET INX=""
- FOR
- SET INX=$ORDER(INFD(INX))
- IF INX=""
- QUIT
- Begin DoDot:1
- +40 SET INY=""
- FOR
- SET INY=$ORDER(INFD(INX,INY))
- IF INY=""
- QUIT
- Begin DoDot:2
- +41 IF $GET(INFD(INX,INY))'=""
- SET INFLN=$GET(INFLN)+1
- End DoDot:2
- End DoDot:1
- +42 ; Calculate total number of the lines
- +43 IF INFLN>0
- SET INCT=$GET(INSLN)+2+$GET(INFLN)+1
- +44 IF INFLN=0
- SET INCT=$GET(INSLN)+1
- +45 IF ($Y+INCT)'>(IOSL-4)
- WRITE !
- +46 IF ($Y+INCT)>(IOSL-4)
- DO HEADER^INHMG
- +47 SET HF2=1
- +48 ; Display for the segment name and the ID
- +49 NEW NL
- SET NL=1
- DO T
- DO N
- IF $GET(DUOUT)
- QUIT
- WRITE "=====Segment Name==================================ID=====Seq No==Req==Rep==OF=="
- +50 DO N
- IF $GET(DUOUT)
- QUIT
- WRITE ?0,$GET(INSG("NM"))
- +51 WRITE ?51,$GET(INSG("NM",1))
- +52 IF $X>58
- DO N
- IF $GET(DUOUT)
- QUIT
- WRITE ?58,$JUSTIFY($GET(INSG("NM",2)),0,1)
- +53 WRITE ?66,$GET(INSG("NM",3))
- +54 WRITE ?71,$GET(INSG("NM",4))
- +55 WRITE ?76,$GET(INSG("NM",5))
- +56 IF $GET(INSG("PS"))'=""
- DO T
- DO N
- IF $GET(DUOUT)
- QUIT
- WRITE ?8,"Parent Segment:",?24,INSG("PS")
- +57 IF $GET(INSG("FL"))'=""
- DO N
- IF $GET(DUOUT)
- QUIT
- WRITE ?18,"File:",?24,INSG("FL")
- +58 IF $GET(INSG("MF"))'=""
- DO N
- IF $GET(DUOUT)
- QUIT
- WRITE ?8,"Multiple Field:",?24,INSG("MF")
- +59 IF $GET(INSG("UD"))'=""
- DO N
- IF $GET(DUOUT)
- QUIT
- WRITE ?4,"User-Defined Index:",?24,INSG("UD")
- +60 IF $GET(INSG("LP"))'=""
- DO N
- IF $GET(DUOUT)
- QUIT
- WRITE ?6,"Lookup Parameter:",?24,INSG("LP")
- +61 IF $GET(INSG("ML"))'=""
- DO N
- IF $GET(DUOUT)
- QUIT
- WRITE ?12,"Make Links:",?24,INSG("ML")
- +62 IF $GET(INSG("TP"))'=""
- DO N
- IF $GET(DUOUT)
- QUIT
- WRITE ?14,"Template:",?24,INSG("TP")
- +63 IF $GET(INSG("RT"))'=""
- DO N
- IF $GET(DUOUT)
- QUIT
- WRITE ?15,"Routine:"
- WRITE ?25,INSG("RT")
- +64 IF $GET(INSG("IF"))'=""
- DO N
- IF $GET(DUOUT)
- QUIT
- WRITE ?14,"ID Field:"
- WRITE ?25,INSG("IF")
- +65 IF $GET(INSG("IV"))'=""
- DO N
- IF $GET(DUOUT)
- QUIT
- WRITE ?14,"ID Value:"
- WRITE ?25,INSG("IV")
- +66 ; Display the fields
- +67 ; Display header for each page. Only display field header if there
- +68 ; is field
- +69 IF INFLN>0
- DO HDR2
- +70 ; If there is no field, then just display a bank line
- +71 IF INFLN=0
- WRITE !
- +72 ; Initialize INT1, set flag HF2 for field header
- +73 SET INT1=""
- SET HF2=0
- +74 FOR
- SET INT1=$ORDER(INFD(INT1))
- IF INT1=""
- QUIT
- IF $GET(DUOUT)
- QUIT
- Begin DoDot:1
- +75 DO T
- IF $GET(DUOUT)
- QUIT
- WRITE !,$$JUST^UTIL(INFD(INT1,"SQ"),3,"R",0),?6,$$JUST^UTIL(INFD(INT1,"SQ","LEN"),3,"R",0),?11,INFD(INT1,"SQ","DT"),?15,INFD(INT1,"SQ","RQ"),?17,INFD(INT1,"SQ","RP")
- +76 WRITE ?19,INFD(INT1,"SQ","LK"),?21,INFD(INT1,"SQ","XF"),?24,INFD(INT1,"SQ","FN")
- +77 SET IDL=$GET(INFD(INT1,"SQ","IDL"))
- +78 ; Truncate display for the Data Location, if the character is too long
- +79 IF $LENGTH(IDL)<(IOM-56)
- WRITE ?56,IDL
- +80 IF $LENGTH(IDL)>(IOM-56)
- WRITE ?56,$EXTRACT(IDL,1,IOM-56),!?56,$EXTRACT(IDL,IOM-55,$LENGTH(IDL))
- +81 IF INFD(INT1,"OIT")'=""
- DO T
- IF $GET(DUOUT)
- QUIT
- WRITE !,?10,"Overide Input Xform: ",INFD(INT1,"OIT")
- QUIT
- +82 IF INFD(INT1,"INV")'=""
- DO T
- IF $GET(DUOUT)
- QUIT
- WRITE !,?10,"Input Validation: ",INFD(INT1,"INV")
- QUIT
- +83 IF INFD(INT1,"INT")'=""
- DO T
- IF $GET(DUOUT)
- QUIT
- WRITE !,?10,"Incoming Xform: ",INFD(INT1,"INT")
- QUIT
- +84 IF INFD(INT1,"OUT")'=""
- DO T
- IF $GET(DUOUT)
- QUIT
- WRITE !,?10,"Outgoing Xform: ",INFD(INT1,"OUT")
- QUIT
- +85 IF $GET(INFD(INT1,"MP"))'=""
- DO T
- IF $GET(DUOUT)
- QUIT
- WRITE !,?10,"Map Function: ",INFD(INT1,"MP")
- QUIT
- End DoDot:1
- +86 QUIT
- N IF $GET(DUOUT)
- QUIT
- WRITE !
- T ; End of page routine
- +1 IF ($Y>(IOSL-4))&(INPAGE>0)
- DO HEADER^INHMG
- IF '$GET(HF2)
- DO HDR2
- SET HF2=1
- +2 QUIT
- HDR2 ;Header 2
- +1 IF $GET(DUOUT)
- QUIT
- DO N
- WRITE !?15,"R R L X"
- DO N
- IF $GET(DUOUT)
- QUIT
- +2 WRITE ?0,"SeqNo Len DT q p k f Field Name Data Location"
- +3 DO N
- IF $GET(DUOUT)
- QUIT
- WRITE "--------------------------------------------------------------------------------"
- +4 QUIT
