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