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

INTSTO.m

Go to the documentation of this file. 
  1. INTSTO ;DGH; 1 May 97 14:57;Unit test Output Controller
  1.  ;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
  1.  ;COPYRIGHT 1991-2000 SAIC
  1.  ;
  1.  ;  !!! If INHOTM is modified, this routine !!!
  1.  ;  !!! may need comparable changes.        !!!
  1.  ;Unit Test Utility which processes entries in the UIF through the
  1.  ;output controller.  Primarily intended to test inbound transactions
  1.  ;but will do any existing transaction.
  1.  ;
  1. EN(INIP,INEXPAND,INDA) ;Entry point
  1.  ;Same entry point used for Starting Process=Output &
  1.  ;Starting Process=Replicator. If Replicator, entries are screened
  1.  ;at the PROCESS tag below.
  1.  ;INPUT:
  1.  ;  INDA= ien in criteria file, 4001.1
  1.  ;  INIP = Array of variables
  1.  ;    INIP("PRE")=pre-processor code
  1.  ;    INIP("POST")=post processor code
  1.  ;    INIP("DIR")=direction. I=IN O=OUT (Not currently used)
  1.  ;    INIP("SPROC")=start at process
  1.  ;  INEXPAND = 0 for brief, 1 for expanded display
  1.  ;OUTPUT:
  1.  ;  ^UTILITY("INTHU",DUZ,$J,<processing order>)=UIF entry to process
  1.  ;
  1.  N UIF,INEXPND,X
  1.  K ^UTILITY("INTHU",DUZ,$J)
  1.  ;UIF entries to process are in ^DIZ or designated with Pre-processor.
  1.  ;Following call gets entries from ^DIZ. Same call as is used in
  1.  ;Interactive Test Utility. It retrieves more data than is used for
  1.  ;this function, but maintains compatibility with ITU.
  1.  D UPDTSND^INTSUT3(INDA)
  1.  ;Reverse INEXPAND LOGIC
  1.  S INEXPND='$G(INEXPAND)
  1.  ;Processing flow copied from LOOP^INTSEND. Thus, flow of pre-processing
  1.  ;and "post-pre" will be identical.
  1.  N INSND,OUT,RCVE,INARY,INEXTN,INEXTUIF,INLASTN,INUPDAT,INOPT,INPOP
  1.  S (INSND,OUT,RCVE,INLASTN,INUPDAT)=0
  1.  S INPOP=1
  1.  F  D  Q:OUT!'INPOP
  1.  .K INARY,INEXTUIF
  1.  .S (INEXTN,INLASTN)=$O(^UTILITY("INTHU",DUZ,$J,INLASTN))
  1.  .I INEXTN S INEXTUIF=$O(^UTILITY("INTHU",DUZ,$J,INEXTN,""))
  1.  .;Pre process
  1.  .I $G(INIP("PRE"))'="" D PRE^INTSUT2(INDA,INIP("PRE"),.INEXTUIF,.INARY)
  1.  .Q:'$$POSTPRE^INTSUT2(INDA,.INARY,.INEXTUIF,.INLASTN,.INPOP,.INUPDAT)
  1.  .;last entry in utility and nothing updated in post process so QUIT
  1.  .I 'INLASTN S OUT=1 Q
  1.  .I '$D(^INTHU(+$G(INEXTUIF),0)) D DISPLAY^INTSUT1("Invalid or missing Universal Interface entry "_$G(INEXTUIF)) S INPOP=0 Q
  1.  .;Process through Output Controller
  1.  .D PROCESS(INEXTUIF,INEXPAND,INDA,.INIP)
  1.  .;Execute post action
  1.  .I $G(INIP("POST"))'="" D POST^INTSUT2(INDA)
  1.  ;save criteria tests if they were updated in the pre or post
  1.  I INUPDAT D
  1.  .N INOPT
  1.  .S INOPT("TYPE")="TEST",INOPT("NONINTER")=1
  1.  .S X=$$SAVE^INHUTC1(.INOPT,INDA,"U")
  1.  K ^UTILITY("INTHU",DUZ,$J)
  1.  Q
  1.  ;
  1. PROCESS(UIF,INEXPAND,INDA,INIP) ;Actual processing of each UIF entry
  1.  ;This entry point may be called from INTSTF, the format tester
  1.  ;or from EN above.
  1.  ;INPUT:
  1.  ;  UIF = entry to process
  1.  ;  INEXPAND = 0 for brief, 1 for expanded display
  1.  ;  INDA = entry in 4001.1
  1.  ;  INIP("DIR")=direction. I=IN O=OUT
  1.  ;  INIP("SPROC")=start at process
  1.  N INMSG,J,L1,LOG,TYPE,DEST,INPOP,INEXPND
  1.  S INPOP=1
  1.  ;Reverse INEXPAND LOGIC
  1.  S INEXPND='$G(INEXPAND)
  1.  ;Following is adapted from SVLOOP^INHOTM
  1.  ;Determine how to process transaction and validate needed data.
  1.  I '$D(^INTHU(+$G(UIF),0)) S INMSG="UIF file entry missing: "_+$G(UIF) D DISPLAY^INTSUT1(INMSG,0) Q
  1.  S TYPE=$$TYPE^INHOTM(UIF)
  1.  I 'DEST D DISPLAY^INTSUT1("Transaction has no destination.",0) Q
  1.  I 'TYPE D DISPLAY^INTSUT1("Destination has no method of processing.",0) Q
  1.  S INMSG="------- Processing message "_$P(^INTHU(UIF,0),U,5)_" -------" D DISPLAY^INTSUT1(INMSG,0,UIF)
  1.  I $G(INIP("SPROC"))="R",$P(^INRHD(DEST,0),U)'["HL REPLICATOR" D  Q
  1.  .S INMSG="Destination "_$P(^INRHD(DEST,0),U)_" is not HL REPLICATOR"
  1.  .D DISPLAY^INTSUT1(INMSG,0)
  1.  I INEXPND D
  1.  .D EXPNDIS^INTSUT1(UIF)
  1.  .S INMSG="Destination: "_$P(^INRHD(DEST,0),U) D DISPLAY^INTSUT1(INMSG,0)
  1.  ;Validate message structure (Only in expanded mode)
  1.  I $G(UIF),INEXPND D
  1.  .S INMSG="---- Validating message structure and required fields -----"
  1.  .D DISPLAY^INTSUT1(INMSG,0)
  1.  .D MAIN^INTSTR(UIF,INEXPND)
  1.  .S INMSG="---- Validation complete  ---------------------------------"
  1.  .D DISPLAY^INTSUT1(INMSG,0)
  1.  Q:'INPOP
  1.  D
  1.  .;Start up a job for entry with a Transceiver Routine
  1.  .I TYPE=2 D OUT^INTSTO1(UIF,INEXPND,DEST) Q
  1.  .;Start up a job for entry with a Transaction Type
  1.  .I TYPE=1 D IN(UIF,INEXPND,DEST) Q
  1.  .;Start up a job for entry with a Mail recipient
  1.  .I TYPE=3 D DISPLAY^INTSUT1("Mail messages not supported",0) Q
  1.  Q
  1.  ;
  1. IN(UIF,INEXPND,DEST) ;process incoming message
  1.  ;INPUT:
  1.  ;  UIF = entry in Universal Interface File for processing
  1.  ;  INEXPND = 0 to not expand, 1 to expand
  1.  ;  DEST = pointer to Interface Destination File
  1.  ;;FOLLOWING COPIED FROM ^INHOS(IEN)
  1.  N INHERR,ER,ERR,INTT,SCR,C,Z,L,L1,INPOP
  1.  S INPOP=1
  1.  S INTT=+$P(^INRHD(DEST,0),U,2) I 'INTT S INMSG="Missing transaction type or entry for destination '"_$P(^INRHD(DEST,0),U) D DISPLAY^INTSUT1(INMSG,0) Q
  1.  I INEXPND S INMSG="Executing script for transaction Type "_$P(^INRHT(INTT,0),U) D DISPLAY^INTSUT1(INMSG,0)
  1.  S SCR=$P(^INRHT(INTT,0),U,3) I 'SCR S INMSG="Missing script for transaction type: '"_$P(^INRHT(INTT,0),U)_"'" D DISPLAY^INTSUT1(INMSG,0) Q
  1.  N INOA,INODA,INA
  1.  K INHERR,INEDIT S:$P(^INTHU(UIF,0),U,15) INEDIT=$P(^(0),U,15) S C=",",Z="N INDEV,INTT,DUZ,DTIME S ER=$$^IS"_$E(SCR#100000+100000,2,6)_"("_UIF_",.INOA,.INODA)" X Z K INEDIT
  1.  ;Display results of script run
  1.  I INEXPND D
  1.  .S INMSG="Inbound script "_$S(ER=0:"completed with no errors",ER=1:"encountered non-fatal error",1:"encountered fatal error")
  1.  .D DISPLAY^INTSUT1(INMSG,0)
  1.  .D:$D(INHERR) ERRS(.INHERR)
  1.  Q:'INPOP
  1.  ;Variable INOA, if set within the inbound script, will be passed as
  1.  ;the INA array to the ACK call.
  1.  ;If it exists display it (but it may be an array with nodes)
  1.  D:INEXPND DISPLAY^INTSUT1("---- Inbound script created following variable arrays",0)
  1.  I INEXPND,$D(INOA) D
  1.  .S QX="INOA"
  1.  .F  S QX=$Q(@(QX)) Q:'$L(QX)  S INMSG=QX_"="_$G(@(QX)) D DISPLAY^INTSUT1(INMSG,0)
  1.  ;Variable INODA, if set within the inbound script, will be passed as
  1.  ;the INDA array to the ACK call.
  1.  I INEXPND,$D(INODA) D
  1.  .S QX="INODA"
  1.  .F  S QX=$Q(@(QX)) Q:'$L(QX)  S INMSG=QX_"="_$G(@(QX)) D DISPLAY^INTSUT1(INMSG,0)
  1.  Q:'INPOP
  1.  D DONE^INHOS
  1.  ;--Display activity log multiple entries
  1.  D ACTLOG(UIF) Q:'INPOP
  1.  ;If incoming transaction created an application ack, display it
  1.  I $P(^INTHU(UIF,0),U,6) D
  1.  .D DISPLAY^INTSUT1("Application acknowledgment "_$P(^INTHU($P(^INTHU(UIF,0),U,6),0),U,5)_" created",0)
  1.  .I INEXPND D EXPNDIS^INTSUT1($P(^INTHU(UIF,0),U,6))
  1.  Q
  1.  ;
  1. ACTLOG(UIF) ;Display entries from activity log multiple
  1.  ;INPUT:
  1.  ;  UIF = entry to process
  1.  N I
  1.  Q:'$D(^INTHU(UIF,1))
  1.  D DISPLAY^INTSUT1("Activity log",0)
  1.  S I=0 F  S I=$O(^INTHU(UIF,1,I)) Q:'I  D
  1.  .S INMSG=^INTHU(UIF,1,I,0) D DISPLAY^INTSUT1(INMSG,0)
  1.  Q
  1.  ;
  1.  ;
  1. ERRS(INHERR) ;Display any errors in INHERR array
  1.  ;INPUT:
  1.  ;  INHERR will still exist if there were errors
  1.  Q:'$D(INHERR)
  1.  N ERR
  1.  I $L($G(INHERR)) D DISPLAY^INTSUT1(INHERR,0)
  1.  S ERR=0 F  S ERR=$O(INHERR(ERR)) Q:'ERR  D
  1.  .D DISPLAY^INTSUT1(INHERR(ERR),0)
  1.  Q
  1.  ;
  1.  ;