Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: INHMG1

INHMG1.m

Go to the documentation of this file. 
  1. INHMG1 ;KN,PO; 18 Jun 99 13:58; Script Generator Message - Print Template 
  1.  ;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
  1.  ;COPYRIGHT 1991-2000 SAIC
  1.  ;
  1.  ; MODULE NAME: Script Generator Message - Print Template (INHMG1).
  1.  ;
  1.  ; PURPOSE:
  1.  ; The purpose of the module INHMG1 is used as a print template
  1.  ; to display the message parts for the selected script generator
  1.  ; message.  The module INHMG1 will handle the segments and fields.
  1.  ;
  1.  ; DESCRIPTION:
  1.  ; The processing of the module INHMG1 is used to call other modules
  1.  ; INHMG2 to build the DXS array. The DXS array contains
  1.  ; the MUMPS code to search global ^INTHL7M for message, ^INTHL7S for
  1.  ; segment, and ^INTHL7F for field to get the details of Script
  1.  ; Generator Message Listing.  The module INHMG1 will display the
  1.  ; message parts for the selected script generator message.  It will
  1.  ; then call module INHMG2 to process the Script Generator Segments
  1.  ; and Fields.
  1.  Q
  1. INBUILD(INCOMSEG) ; Entry point
  1.  ;
  1.  ; Description: INBUILD is the entry point for the module INHMG1.
  1.  ;   It will call modules INHMG1 and INHMG2 to build the
  1.  ;  DXS array, then display the message details for
  1.  ;  the selected message.  It also receive option
  1.  ;  INCOMSEG from module INHMG.
  1.  ;
  1.  ; Return: None
  1.  ; Parameters:
  1.  ;  INCOMSEG : option for display common segment
  1.  ;       INCOMSEG: 1 = display
  1.  ;   0 = not display
  1.  ;
  1.  ; Code begins:
  1.  K DIOUT
  1.  D:$D(DXS)<9 INDXS^INHMG
  1.  D N:$X>0 W ?0 W "***** Message *****************************************************************"
  1.  ;
  1.  S X=$G(^INTHL7M(D0,0)) D N Q:$G(DUOUT)  W $E($P(X,U),1,45)
  1.  W ?66,"Inactive:",?76 S Y=$P(X,U,8),Y=$S(Y="":Y,$D(DXS(18,Y)):DXS(18,Y),1:Y) W Y
  1.  F D1=0:0 Q:'$O(^INTHL7M(D0,3,D1))!$G(DUOUT)  S D1=$O(^(D1)) D:$X>79 T D
  1.  .S X=$G(^INTHL7M(D0,3,D1,0)) D N Q:$G(DUOUT)  W ?4,X
  1.  Q:$G(DUOUT)
  1.  ;
  1.  D T,N Q:$G(DUOUT)  W ?5,"Standard:"
  1.  S DXN(0)=$G(^INTHL7M(D0,0)) W ?15,$E($P(DXN(0),U,12),1,20)
  1.  D N Q:$G(DUOUT)  W ?3,"Event Type:"
  1.  W ?15,$E($P(DXN(0),U,2),1,20)
  1.  ;
  1.  W ?41,"Message Type:",?56,$E($P(DXN(0),U,6),1,3)
  1.  D N Q:$G(DUOUT)  W ?1,"Send Applic.:"
  1.  S X=$G(^INTHL7M(D0,7)) W ?15,$E($P(X,U),1,25)
  1.  W ?41,"Rec. Applic.:",?55,$E($P(X,U,3),1,25)
  1.  D N Q:$G(DUOUT)  W ?5,"Facility:",?15,$E($P(X,U,2),1,25)
  1.  W ?45,"Facility:",?55,$E($P(X,U,4),1,25)
  1.  D N Q:$G(DUOUT)  W "Processing ID:"
  1.  S X=$G(DXN(0)) W ?15 S Y=$P(X,U,3),Y=$S(Y="":Y,$D(DXS(19,Y)):DXS(19,Y),1:Y) W Y
  1.  W ?28,"HL7 Version:",?41,$E($P(X,U,4),1,5)
  1.  W ?48,"Lookup Parameter:",?66 S Y=$P(X,U,7),Y=$S(Y="":Y,$D(DXS(20,Y)):DXS(20,Y),1:Y) W Y
  1.  D N Q:$G(DUOUT)  W ?3,"Accept Ack:",?15 S Y=$P(X,U,10),Y=$S(Y="":Y,$D(DXS(21,Y)):DXS(21,Y),1:Y) W Y
  1.  W ?49,"Application Ack:",?66 S Y=$P(X,U,11),Y=$S(Y="":Y,$D(DXS(22,Y)):DXS(22,Y),1:Y) W Y
  1.  D N Q:$G(DUOUT)  W ?4,"Root File:",?15 S Y=$P(X,U,5),Y=$S(Y="":Y,$D(^DIC(Y,0))#2:$P(^(0),U),1:" "_Y) W $E(Y,1,40)
  1.  W ?57,"Audited:",?66 S Y=$P(X,U,9),Y=$S(Y="":Y,$D(DXS(18,Y)):DXS(18,Y),1:Y) W Y
  1.  D N Q:$G(DUOUT)  W "Routine for Lookup/Store:"
  1.  S X=$G(^INTHL7M(D0,5)) W ?26,$E($E(X,1,200),1,54)
  1.  D N Q:$G(DUOUT)  W "Transaction Types:"
  1.  D RPTRANS(D0,"D N^INHMG1")
  1.  ;
  1.  D N Q:$G(DUOUT)  W "MUMPS Code for Lookup:"
  1.  F D1=0:0 Q:'$O(^INTHL7M(D0,4,D1))!$G(DUOUT)  S D1=$O(^(D1)) D:$X>22 T D  Q:$G(DUOUT)
  1.  .S X=$G(^INTHL7M(D0,4,D1,0)) D N Q:$G(DUOUT)  W ?4,X
  1.  Q:$G(DUOUT)
  1.  D N Q:$G(DUOUT)  W "Outgoing Initial MUMPS Code:"
  1.  F D1=0:0 Q:'$O(^INTHL7M(D0,6,D1))!$G(DIOUT)  S D1=$O(^(D1)) D:$X>28 T D  Q:$G(DIOUT)
  1.  .S X=$G(^INTHL7M(D0,6,D1,0)) D N Q:$G(DUOUT)  W ?4,X
  1.  Q:$G(DUOUT)
  1.  D N Q:$G(DUOUT)  W "Generated Scripts -"
  1.  D N Q:$G(DUOUT)  W ?3,"Input:"
  1.  S (DXN("S"),X)=$G(^INTHL7M(D0,"S")) D N:$X>10 W ?10 S Y=$P(X,U),Y=$S(Y="":Y,$D(^INRHS(Y,0))#2:$P(^(0),U),1:" "_Y) W $E(Y,1,60)
  1.  D N Q:$G(DUOUT)  W ?2,"Output:"
  1.  W ?10 S Y=$P(X,U,2),Y=$S(Y="":Y,$D(^INRHS(Y,0))#2:$P(^(0),U),1:" "_Y) W $E(Y,1,60)
  1.  ;
  1.  K INSAR
  1.  ;Save D1 and Seq in array INSAR - INSAR(seq,D1)=""
  1.  S D1=0 F  S D1=$O(^INTHL7M(D0,1,D1)) Q:D1'>0!$G(DUOUT)  D:$X>70 T S INX=$P($G(^(D1,0)),U,2),INSAR(INX,D1)=""
  1.  ;Loop through array INSAR and display all the segments
  1.  S INI="INSAR"  F  S INI=$Q(@INI) Q:'$L(INI)  S D1=$$QS^INHUTIL(INI,2) D INSEG(INCOMSEG,D0,D1)
  1.  K Y,DXN,DIWF
  1.  Q
  1. N W !
  1. T W:$X ! I $D(IOSL),($Y>(IOSL-3))  D HEADER^INHMG  W:$X !
  1.  Q
  1.  ;
  1. INSEG(INCOMSEG,D0,D1) ; get segment details and call INHMG2 for processing
  1.  Q:'$D(^INTHL7M(D0,1,D1,0))
  1.  ; check for common segment, and display if INCOMSEG is Y
  1.  S INX=$G(^INTHL7M(D0,1,D1,0)),INY=$P(INX,U) Q:'$D(^INTHL7S(INY))  S INZ=$G(^INTHL7S(INY,0)),INA=$P(INZ,U,2) Q:((INA["MSH")!(INA["PID"))&(INCOMSEG=0)
  1.  ; INSG stores the lines for segments and fields display.
  1.  K INSG,INFD
  1.  ; Get all the segment info and store in array INSG and INFD
  1.  S (DXN(0),X)=$G(^INTHL7M(D0,1,D1,0)) S Y=$P(INX,U),Y=$S(Y="":Y,$D(^INTHL7S(Y,0))#2:$P(^(0),U),1:" "_Y),INSG("NM")=$E(Y,1,45)
  1.  N DIP X DXS(2,9.2) S D1=I(1,0) K DIP S INSG("NM",1)=$E(X,1,6)
  1.  S X=$G(DXN(0)),Y=$P(X,U,2) S INSG("NM",2)=Y
  1.  S Y=$P(X,U,9),INSG("NM",3)=$S(Y="":Y,$D(DXS(18,Y)):DXS(18,Y),1:Y)
  1.  S Y=$P(X,U,3),INSG("NM",4)=$S(Y="":Y,$D(DXS(18,Y)):DXS(18,Y),1:Y)
  1.  S Y=$P(X,U,4),INSG("NM",5)=$S(Y="":Y,$D(DXS(18,Y)):DXS(18,Y),1:Y)
  1.  S Y=$P(X,U,11),Y=$S(Y="":Y,$D(^INTHL7S(Y,0))#2:$P(^(0),U),1:" "_Y),INSG("PS")=$E(Y,1,45)
  1.  S Y=$P(X,U,5),Y=$S(Y="":Y,$D(^DIC(Y,0))#2:$P(^(0),U),1:" "_Y),INSG("FL")=$E(Y,1,45)
  1.  S Y=$P(X,U,8),INSG("MF")=$E($P(X,U,8),1,30)
  1.  S INSG("IF")=$E($P(X,U,18),1,30)
  1.  S INSG("IV")=$E($P(X,U,19),1,30)
  1.  S INSG("UD")=$P(X,U,12)
  1.  S Y=$P(X,U,7),INSG("LP")=$S(Y="":Y,$D(DXS(20,Y)):DXS(20,Y),1:Y)
  1.  S Y=$P(X,U,10),INSG("ML")=$S(Y="":Y,$D(DXS(18,Y)):DXS(18,Y),1:Y)
  1.  S Y=$P(X,U,6),INSG("TP")=$E($P(X,U,6),1,30)
  1.  S X=$G(^INTHL7M(D0,1,D1,3)),INSG("RT")=$E(X,1,100)
  1.  D INFIELD^INHMG2(.INSG,D0,D1,INCOMSEG)
  1.  Q
  1.  ;-------------------------------------------------------------
  1. RPTRANS(D0,XHDR,INOSTAT) ;compile and display transaction types
  1.  ;Input:
  1.  ;  D0  - ien of the message in the scripting generator message file
  1.  ;  XHDR-  mumps code (for more info refer to WTRANS sub-rotuine)
  1.  ;  INOSTAT - if set do not show the active/inactive status of transactions
  1.  ;Output:
  1.  ;  display the transaction types
  1.  ; Note : this sub-routine is called from
  1.  ;          INBUILD^INHMG1 routine and
  1.  ;          [INHSG MESSAGE] print template
  1.  ;
  1.  N INRES
  1.  D GTRANS(D0,.INRES)
  1.  D WTRANS(.INRES,XHDR,$G(INOSTAT))
  1.  Q
  1.  ;
  1. GTRANS(D0,INRES) ; get the list of transacions for a given message
  1.  ;Input :
  1.  ;  D0  - ien of the message in the scripting generator message file
  1.  ;INRES -  name of the array or global, to put the transaction ien in
  1.  ;Output :
  1.  ;  INRES-  array containg the transaction list in its subscript.
  1.  ;         INRES(child tran. ien)=""
  1.  ;         INRES(child tran. replicated ien,  trans ien)=""
  1.  ;
  1.  ;
  1.  N REPDEST,REPIEN,D1,TRNIEN,TRNODE,MRPIEN
  1.  S REPDEST=+$O(^INRHD("B","HL REPLICATOR",0))  ; replicator ien in destination file
  1.  ;   find the message's transaction in the scripting generator message
  1.  ;   file
  1.  S D1=0
  1.  F  S D1=$O(^INTHL7M(D0,2,D1)) Q:'D1  D    ;loop thru transaction type multiple
  1.  .S TRNIEN=+$G(^INTHL7M(D0,2,D1,0))    ; transaction ien
  1.  .Q:'TRNIEN
  1.  .S TRNODE=$G(^INRHT(TRNIEN,0))   ;interface transaction type node zero
  1.  .S INRES(TRNIEN)=""
  1.  .Q:$P(TRNODE,U,2)'=REPDEST       ;quit if NOT replicated transaction
  1.  .;  loop thru "AC x-ref on originating transaction type in
  1.  .;  interface message replication file
  1.  .S MRPIEN=0
  1.  .F  S MRPIEN=+$O(^INRHR("AC",TRNIEN,MRPIEN)) Q:'MRPIEN  D
  1.  ..S REPIEN=+$P($G(^INRHR(MRPIEN,0)),U)
  1.  ..S INRES(TRNIEN,REPIEN)=""
  1.  ;
  1.  Q
  1.  ;
  1. WTRANS(INRES,XHDR,INOSTAT) ;write the transactions
  1.  ;Input:
  1.  ;  INRES-  array containg the transaction list in its subscript.
  1.  ;         INRES(child tran. ien)=""
  1.  ;         INRES(child tran. replicated ien,  trans ien)=""
  1.  ;  XHDR-  mumps code is used for page break and/or ask the user
  1.  ;         if he/she want to coninue to abort.   e.g.
  1.  ;           D N^INHMG1   or
  1.  ;           D T^DIWW     when this is called from FileMan
  1.  ;                        print template (transaction type)
  1.  ;         in XHDR routines if user aborts, it should set
  1.  ;         DUOUT to true, else is false or undefined
  1.  ;  INOSTAT - if set to true do not show the active/inactive status of transactions
  1.  ;
  1.  N D0,ACTIVE,NAME,DEST,D1
  1.  S D0=""
  1.  F  S D0=+$O(INRES(D0)) Q:'D0!$G(DUOUT)  D
  1.  .D GTRNDATA(D0,INOSTAT,.NAME,.ACTIVE,.DEST)
  1.  .X XHDR
  1.  .W NAME,?70,ACTIVE
  1.  .I $G(DEST)'="" X XHDR W ?22,"Destination: ",DEST
  1.  .S D1=""
  1.  .F  S D1=+$O(INRES(D0,D1)) Q:'D1!$G(DUOUT)  D
  1.  ..D GTRNDATA(D1,INOSTAT,.NAME,.ACTIVE,.DEST)
  1.  ..X XHDR
  1.  ..W "--->",NAME,?70,ACTIVE
  1.  ..I $G(DEST)'="" X XHDR W ?22,"Destination: ",DEST
  1.  Q
  1.  ;
  1. GTRNDATA(TRNIEN,INOSTAT,NAME,ACTIVE,DEST) ;get some field values for
  1.  ;Input:
  1.  ;  TRNIEN   -  transaction ien
  1.  ;  INOSTAT -   if true, set the active/inactive status to null
  1.  ;Output:
  1.  ;  NAME     -  transaction name
  1.  ;  ACTIVE   -  "ACTIVE" if trans is active, else null
  1.  ;  DEST     -  destination name
  1.  N NODE
  1.  S NODE=$G(^INRHT(TRNIEN,0))
  1.  S NAME=$P(NODE,U)
  1.  S ACTIVE=$S(INOSTAT:"",$P(NODE,U,5)=1:"active",1:"inactive")
  1.  S DEST=$P($G(^INRHD(+$P(NODE,U,2),0)),U)
  1.  Q
  1.  ;