- INHSYSU1 ;utilities for GIS
- ;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
- ;COPYRIGHT 1991-2000 SAIC
- ;
- Q
- CMPFLD ;Compile all messages related to field chosen
- N INCMP
- S INCMP=1
- D FLD
- Q
- FLD ;Lookup and display all Messages related to selected field
- N Y,DIC
- S DIC="^INTHL7F(",DIC(0)="AEQZ",DIC("A")="Enter Script Generator Field Name: "
- D ^DIC
- Q:Y<0
- D ZIS^INHUT3("PRFLD^INHSYSU1("_+Y_")","INCMP")
- Q
- PRFLD(INFLD) ;Print field
- ; Input: INFLD - ien of Script Generator Field
- N INSCR,INMSG,INGALL
- S INSCR=""
- I '$D(INCMP) W !!,"Script Generator Segment"
- F S INSCR=$O(^INTHL7S("FIELD",INFLD,INSCR)) Q:INSCR="" D
- .I '$D(INCMP) W !,$P($G(^INTHL7S(INSCR,0)),U),!!,"Script Generator Messages"
- .S INMSG="" F S INMSG=$O(^INTHL7M("SEG",INSCR,INMSG)) Q:INMSG="" D
- ..I '$D(INCMP) W !,$P($G(^INTHL7M(INMSG,0)),U)
- ..E S INMSG(INMSG)=""
- I $G(INCMP) S INMSG="",INGALL=1 F S (INMSG,Y)=$O(INMSG(INMSG)) Q:'Y D EN^INHSGZ
- Q
- CMPSEG ;Compile all messages related to segment
- N INCMP
- S INCMP=1
- D SEG
- Q
- SEG ;Display Script Generator Message pointing to Segment
- N Y,DIC
- S DIC="^INTHL7S(",DIC(0)="AEQZ",DIC("A")="Enter Script Generator Segment Name: "
- D ^DIC
- Q:Y<0
- D ZIS^INHUT3("PRSEG^INHSYSU1("_+Y_")","INCMP")
- Q
- PRSEG(INSCR) ;print segment
- ; Input: INSCR - ien of Script generator Message
- N INMSG,INGALL
- S INSCR=+Y
- I '$D(INCMP) W !!,"Script Generator Messages"
- S INMSG="" F S INMSG=$O(^INTHL7M("SEG",INSCR,INMSG)) Q:INMSG="" D
- .I '$D(INCMP) W !,$P($G(^INTHL7M(INMSG,0)),U)
- .E S INMSG(INMSG)=""
- I $G(INCMP) S INMSG="",INGALL=1 F S (INMSG,Y)=$O(INMSG(INMSG)) Q:'Y D EN^INHSGZ
- Q
- GETMSGF(INFL,INMS,INMSG) ;Get messages related to field
- ; Input: INFL - ien of Script Generator Field
- ; Output INMS - Array of Script Generator Messages
- ; In/Out(opt) INMSG - Array of messages
- N INSCR,INM
- S INSCR=""
- F S INSCR=$O(^INTHL7S("FIELD",INFL,INSCR)) Q:INSCR="" D
- .K INMSG(4010,INSCR)
- .S INM="" F S INM=$O(^INTHL7M("SEG",INSCR,INM)) Q:INM="" D
- ..S INMS(INM)=$P($G(^INTHL7M(INM,0)),U)
- ..K INMSG(4011,INM)
- Q
- GETMSGS(INSG,INMS,INMSG) ;Get messages related to segment
- ; Input: INSG - ien of Script Generator Segment
- ; Output INMS - Array of Script Generator Messages
- ; In/Out(opt) INMSG - Array of messages
- N INM
- S INM="" F S INM=$O(^INTHL7M("SEG",INSG,INM)) Q:INM="" D
- .S INMS(INM)=$P($G(^INTHL7M(INM,0)),U)
- .K INMSG(4011,INM)
- Q
- GETMSGDT(INM,INMS) ;Get messages related to Data Type
- ; Input: INM - array of Data types
- ; Output INMS - Array of Script Generator Messages
- ;Loop through fields looking for pointers to data type in array
- N INF
- S INF=0 F S INF=$O(^INTHL7F(INF)) Q:'INF D
- .I $D(INM(4012.1,+$P($G(^INTHL7F(INF,0)),U,2))) D
- ..D GETMSGF(INF,.INMS)
- ..K INM(4012,INF)
- Q
- INHSYSU1 ;utilities for GIS
- +1 ;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
- +2 ;COPYRIGHT 1991-2000 SAIC
- +3 ;
- +4 QUIT
- CMPFLD ;Compile all messages related to field chosen
- +1 NEW INCMP
- +2 SET INCMP=1
- +3 DO FLD
- +4 QUIT
- FLD ;Lookup and display all Messages related to selected field
- +1 NEW Y,DIC
- +2 SET DIC="^INTHL7F("
- SET DIC(0)="AEQZ"
- SET DIC("A")="Enter Script Generator Field Name: "
- +3 DO ^DIC
- +4 IF Y<0
- QUIT
- +5 DO ZIS^INHUT3("PRFLD^INHSYSU1("_+Y_")","INCMP")
- +6 QUIT
- PRFLD(INFLD) ;Print field
- +1 ; Input: INFLD - ien of Script Generator Field
- +2 NEW INSCR,INMSG,INGALL
- +3 SET INSCR=""
- +4 IF '$DATA(INCMP)
- WRITE !!,"Script Generator Segment"
- +5 FOR
- SET INSCR=$ORDER(^INTHL7S("FIELD",INFLD,INSCR))
- IF INSCR=""
- QUIT
- Begin DoDot:1
- +6 IF '$DATA(INCMP)
- WRITE !,$PIECE($GET(^INTHL7S(INSCR,0)),U),!!,"Script Generator Messages"
- +7 SET INMSG=""
- FOR
- SET INMSG=$ORDER(^INTHL7M("SEG",INSCR,INMSG))
- IF INMSG=""
- QUIT
- Begin DoDot:2
- +8 IF '$DATA(INCMP)
- WRITE !,$PIECE($GET(^INTHL7M(INMSG,0)),U)
- +9 IF '$TEST
- SET INMSG(INMSG)=""
- End DoDot:2
- End DoDot:1
- +10 IF $GET(INCMP)
- SET INMSG=""
- SET INGALL=1
- FOR
- SET (INMSG,Y)=$ORDER(INMSG(INMSG))
- IF 'Y
- QUIT
- DO EN^INHSGZ
- +11 QUIT
- CMPSEG ;Compile all messages related to segment
- +1 NEW INCMP
- +2 SET INCMP=1
- +3 DO SEG
- +4 QUIT
- SEG ;Display Script Generator Message pointing to Segment
- +1 NEW Y,DIC
- +2 SET DIC="^INTHL7S("
- SET DIC(0)="AEQZ"
- SET DIC("A")="Enter Script Generator Segment Name: "
- +3 DO ^DIC
- +4 IF Y<0
- QUIT
- +5 DO ZIS^INHUT3("PRSEG^INHSYSU1("_+Y_")","INCMP")
- +6 QUIT
- PRSEG(INSCR) ;print segment
- +1 ; Input: INSCR - ien of Script generator Message
- +2 NEW INMSG,INGALL
- +3 SET INSCR=+Y
- +4 IF '$DATA(INCMP)
- WRITE !!,"Script Generator Messages"
- +5 SET INMSG=""
- FOR
- SET INMSG=$ORDER(^INTHL7M("SEG",INSCR,INMSG))
- IF INMSG=""
- QUIT
- Begin DoDot:1
- +6 IF '$DATA(INCMP)
- WRITE !,$PIECE($GET(^INTHL7M(INMSG,0)),U)
- +7 IF '$TEST
- SET INMSG(INMSG)=""
- End DoDot:1
- +8 IF $GET(INCMP)
- SET INMSG=""
- SET INGALL=1
- FOR
- SET (INMSG,Y)=$ORDER(INMSG(INMSG))
- IF 'Y
- QUIT
- DO EN^INHSGZ
- +9 QUIT
- GETMSGF(INFL,INMS,INMSG) ;Get messages related to field
- +1 ; Input: INFL - ien of Script Generator Field
- +2 ; Output INMS - Array of Script Generator Messages
- +3 ; In/Out(opt) INMSG - Array of messages
- +4 NEW INSCR,INM
- +5 SET INSCR=""
- +6 FOR
- SET INSCR=$ORDER(^INTHL7S("FIELD",INFL,INSCR))
- IF INSCR=""
- QUIT
- Begin DoDot:1
- +7 KILL INMSG(4010,INSCR)
- +8 SET INM=""
- FOR
- SET INM=$ORDER(^INTHL7M("SEG",INSCR,INM))
- IF INM=""
- QUIT
- Begin DoDot:2
- +9 SET INMS(INM)=$PIECE($GET(^INTHL7M(INM,0)),U)
- +10 KILL INMSG(4011,INM)
- End DoDot:2
- End DoDot:1
- +11 QUIT
- GETMSGS(INSG,INMS,INMSG) ;Get messages related to segment
- +1 ; Input: INSG - ien of Script Generator Segment
- +2 ; Output INMS - Array of Script Generator Messages
- +3 ; In/Out(opt) INMSG - Array of messages
- +4 NEW INM
- +5 SET INM=""
- FOR
- SET INM=$ORDER(^INTHL7M("SEG",INSG,INM))
- IF INM=""
- QUIT
- Begin DoDot:1
- +6 SET INMS(INM)=$PIECE($GET(^INTHL7M(INM,0)),U)
- +7 KILL INMSG(4011,INM)
- End DoDot:1
- +8 QUIT
- GETMSGDT(INM,INMS) ;Get messages related to Data Type
- +1 ; Input: INM - array of Data types
- +2 ; Output INMS - Array of Script Generator Messages
- +3 ;Loop through fields looking for pointers to data type in array
- +4 NEW INF
- +5 SET INF=0
- FOR
- SET INF=$ORDER(^INTHL7F(INF))
- IF 'INF
- QUIT
- Begin DoDot:1
- +6 IF $DATA(INM(4012.1,+$PIECE($GET(^INTHL7F(INF,0)),U,2)))
- Begin DoDot:2
- +7 DO GETMSGF(INF,.INMS)
- +8 KILL INM(4012,INF)
- End DoDot:2
- End DoDot:1
- +9 QUIT