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

INTSTF.m

Go to the documentation of this file. 
  1. INTSTF ;DGH; 11 Jun 97 12:07;Unit Test Formatter functions
  1.  ;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
  1.  ;COPYRIGHT 1991-2000 SAIC
  1.  ;
  1.  ;  !!! If routine INHFTM is modified, this routine !!!
  1.  ;  !!! may need comparable change.                 !!!
  1.  ;Unit Test Utility to test format queue entries through the
  1.  ;format controller.
  1.  Q
  1.  ;
  1. EN(INIP,INEXPAND,INDA) ;Specify an entry from the format queue
  1.  ;INPUT:
  1.  ;  INIP = array of PRE and POST executable code. PRE must set...
  1.  ;  a) INTSK  =  entry to be processed in ^INLHFTSK or
  1.  ;  b) INTSK(entry) = array of entries from ^INLHFTSK
  1.  ;  INEXPAND = expanded display (0) or brief (1)
  1.  ;  INDA = ien in criteria file, 4001.1
  1.  ;INTERNAL VARIABLES:
  1.  ;  INEXPND = reverse logic of INEXPAND
  1.  ;
  1.  N INREQLST,INLST,UIF,INEXPND,INMSG,INTSK,INIDA,INEXTSK,INARY,INDO,INPOP
  1.  K ^UTILITY("INTHU",DUZ)
  1.  S INEXPND='$G(INEXPAND)
  1.  ;Protect INDA and DUZ
  1.  S INIDA=INDA,INDUZ=DUZ
  1.  N INDA,DUZ
  1.  S DUZ=.5,DUZ(0)="@"
  1.  S (INSND,OUT,RCVE,INLASTN,INUPDAT)=0,INPOP=1
  1.  ;Loop until there is nothing left to do or user aborts.
  1.  F  D  Q:OUT!'INPOP
  1.  .K INARY,INEXTSK
  1.  .S (INEXTN,INLASTN)=$O(^UTILITY("INTHU",INDUZ,$J,INLASTN))
  1.  .I INEXTN S INEXTSK=$O(^UTILITY("INTHU",INDUZ,$J,INEXTN,""))
  1.  .;Pre process
  1.  .I $G(INIP("PRE"))'="" D PRE^INTSUT2(INIDA,INIP("PRE"),.INEXTSK,.INARY)
  1.  .;set INARY to task queue--defualt would have been to UIF
  1.  .S INARY="^INLHFTSK"
  1.  .Q:'$$POSTPRE^INTSUT2(INIDA,.INARY,.INEXTSK,.INLASTN,.INPOP,.INPUDAT)
  1.  .;Pre-processor should have created an entry for INEXTSK
  1.  .I '$G(INEXTSK) S OUT=1 Q
  1.  .;Execute format controller logic on next entry
  1.  .D FMT(INEXTSK,.INIP,INEXPND,.INREQLST)
  1.  .S INDO=1
  1.  .;Execute post action. Any Pre and Post defined in criteria
  1.  .;screen wrap around Format process if "Start at Process"=Format
  1.  .I $G(INIP("POST"))'="" D
  1.  ..I INEXPND S INMSG="Executing post processor code" D DISPLAY^INTSUT1(INMSG,0) Q:'INPOP
  1.  ..D POST^INTSUT2(INIDA)
  1.  .;IF FMT tag didn't create an INREQLST array, nothing left to do
  1.  .Q:'$D(INREQLST)
  1.  .;Execute Output Controller logic.
  1.  .S INLST="" F  S INLST=$O(INREQLST(INLST)) Q:'INLST  D
  1.  ..D PROCESS^INTSTO(INLST,INEXPAND,INIDA,.INIP)
  1.  .K INREQLST
  1.  ;Message if nothing was processed
  1.  D:'$G(INDO)
  1.  .D DISPLAY^INTSUT1("No format entries processed!",0)
  1.  .S INMSG="Formatter test requires INTSK to exist as a variable or an array" D DISPLAY^INTSUT1(INMSG,0)
  1.  .S INMSG="set to one or more entries in the Formatter Task File." D DISPLAY^INTSUT1(INMSG,0)
  1.  .S INMSG="The format is either INTSK=entry or INTSK(entry)=""""" D DISPLAY^INTSUT1(INMSG,0)
  1.  .S INMSG="Use Pre-Processor code to create the entries." D DISPLAY^INTSUT1(INMSG,0)
  1.  Q
  1.  ;
  1. FMT(INTSK,INIP,INEXPND,INREQLST) ;Working section of the code
  1.  ;Modified version of BACK^INHFTM, revised to control script processing
  1.  ;INPUT:
  1.  ; INTSK = entry in Formatter Task File
  1.  ; INIP= array of variables set in criteria screen
  1.  ; INEXPND=1 for expanded, 0 for not (reverse of ININEXPND)
  1.  ;OUTPUT:
  1.  ; INREQLST array of entries created in the UIF (PBR)
  1.  ;
  1.  D SCR^INTSUT1(7,17)
  1.  N PRIO,INMSG,DA,DEST,DIK,I,INI1,INTT,INDA,INDIPA,INIDA,X,INJ,INORDUZ,INORDIV
  1.  S INPOP=1
  1.  ;BACK^INHF protects INBPN and INHSRVR here. Not needed for IUTU
  1.  ;--Initial validation of message to be processed
  1.  I '$D(^INLHFTSK(INTSK,0)) S INMSG="Task "_INTSK_" does not exist in INLHFTSK" D DISPLAY^INTSUT1(INMSG,0) Q
  1.  S X=^INLHFTSK(INTSK,0),INTT=+X,INIDA=$P(X,U,2),(DUZ,INORDUZ)=$P(X,U,3),INORDIV=$P(X,U,7)
  1.  I INEXPND S INMSG="------- Processing Format Task Queue Entry "_INTSK_"--------" D DISPLAY^INTSUT1(INMSG,0)
  1.  S INMSG="Parent Transaction Type: "_$P(^INRHT(INTT,0),U) D DISPLAY^INTSUT1(INMSG,0)
  1.  S:$P(X,U,5) DUZ(2)=$P(X,U,5)
  1.  D SETDT^UTDT
  1.  X:$L($G(^INRHSITE(1,1))) $G(^INRHSITE(1,1))
  1.  ;Load and display INDIPA/INA array
  1.  I $D(^INLHFTSK(INTSK,2))>9 D
  1.  .M INDIPA=^INLHFTSK(INTSK,2)
  1.  .Q:'INEXPND
  1.  .D DISPLAY^INTSUT1("INA values:",0)
  1.  .S QX="INDIPA"
  1.  .F  S QX=$Q(@(QX)) Q:'$L(QX)  S INMSG=QX_"="_$G(@(QX)) D DISPLAY^INTSUT1(INMSG,0)
  1.  ;Load and display INDA values
  1.  I $D(^INLHFTSK(INTSK,1)) D
  1.  .M INIDA=^INLHFTSK(INTSK,1)
  1.  .Q:'INEXPND
  1.  .D DISPLAY^INTSUT1("INDA values:",0)
  1.  .S INMSG="INDA = "_INIDA D DISPLAY^INTSUT1(INMSG,0)
  1.  .S QX="INIDA"
  1.  .F  S QX=$Q(@(QX)) Q:'$L(QX)  S INMSG=QX_"="_$G(@(QX)) D DISPLAY^INTSUT1(INMSG,0)
  1.  D:INEXPND DISPLAY^INTSUT1("Parent has the following active children:",0)
  1.  Q:'INPOP
  1.  S I="" F  S I=$O(^INRHT("AC",INTT,I)) Q:'I  D
  1.  .;Display only active children
  1.  .I $P($G(^INRHT(I,0)),U,5) D
  1.  ..S INJ(+$P(^INRHT(I,0),U,7),I)=""
  1.  ..I INEXPND S INMSG="     "_$P(^INRHT(I,0),U) D DISPLAY^INTSUT1(INMSG,0)
  1.  ;If dependencies exist, display dependencies 1 through 9, then 0
  1.  I $D(INJ) D  Q:'INPOP
  1.  .S PRIO=.9 F  S PRIO=$O(INJ(PRIO)) Q:'PRIO  D JL(.INJ,PRIO,.INDIPA,.INIDA,.INORDUZ,INORDIV) Q:'INPOP
  1.  .S PRIO=0 D JL(.INJ,PRIO,.INDIPA,.INIDA,.INORDUZ,INORDIV)
  1.  S INMSG="------- Formatting of Task File entry "_INTSK_" completed ------" D DISPLAY^INTSUT1(INMSG,0)
  1.  ;Kill entry from ^INLHFTSK
  1.  S DIK="^INLHFTSK(",DA=INTSK D ^DIK
  1.  Q
  1.  ;
  1. JL(INJ,PRIO,INDIPA,INIDA,INORDUZ,INORDIV) ;Loop through jobs at priority PRIO
  1.  ;This is a modified version of JL^INHFTM
  1.  ;INPUT:
  1.  ;  INJ(PRIO,TRT) = array of child TTs in priority order
  1.  ;  INDIPA = "INA" array loaded from task file
  1.  ;  INIDA = "INDA" array loaded from task file
  1.  ;  INORDUZ = DUZ loaded from task file
  1.  ;  INORDIV = Division loaded from task file
  1.  N INPOP,TRT,SCR,INTNAME,INHERR,ERR,ER,Z
  1.  S INPOP=1
  1.  S TRT=0 F  S TRT=$O(INJ(PRIO,TRT)) Q:'TRT!'INPOP  D
  1.  .;;Future**If transaction parameter is set, only continue if this is
  1.  .;;the transaction type selected by user.
  1.  .;;;IF $G(INPARM("TT"),$G(INPARM("TT")'=TRT Q
  1.  .;Preserve original values of INIDA (INDA) and INA (INDIPA) through
  1.  .;script processing. They will be needed for subsequent children.
  1.  .N INA,INDA
  1.  .M INA=INDIPA,INDA=INIDA
  1.  .K INV,UIF
  1.  .;Get child TT info, including script and destination
  1.  .S SCR=$P(^INRHT(TRT,0),U,3),DEST=+$P(^INRHT(TRT,0),U,2),INTNAME=$P(^(0),U)
  1.  .S INMSG="------- Formatting child transaction: "_INTNAME_" --------" D DISPLAY^INTSUT1(INMSG,0) Q:'INPOP
  1.  .;Avoid "no program" error if script is missing
  1.  .I 'SCR S INMSG="No script for transaction type "_INTNAME D DISPLAY^INTSUT1(INMSG,0) Q
  1.  .I INEXPND S INMSG="Script name: "_$P(^INRHS(SCR,0),U) D DISPLAY^INTSUT1(INMSG,0)
  1.  .S INMSG="Destination: "_$P($G(^INRHD(DEST,0)),U) D DISPLAY^INTSUT1(INMSG,0) Q:'INPOP
  1.  .K ^UTILITY("INDA",$J) M ^UTILITY("INDA",$J)=INDA
  1.  .;Set "no queue" parameter to 1 so UIF entry will not be queued.
  1.  .S Z="S ER=$$^IS"_$E(SCR#100000+100000,2,6)_"("_TRT_",.INDA,.INA,"_DEST_",1,$G(INORDUZ,DUZ),$G(INORDIV))"
  1.  .D
  1.  ..X Z I $G(UIF)>0 D
  1.  ...S INMSG="Message "_$P(^INTHU(UIF,0),U,5)_" created in the UIF" D DISPLAY^INTSUT1(INMSG,0,UIF) Q:'INPOP
  1.  ...M ^INTHU(UIF,6)=^UTILITY("INDA",$J)
  1.  ...I $D(INA("DMISID")) M ^INTHU(UIF,7,"DMISID")=INA("DMISID")
  1.  ...I $D(INA("MSGTYPE")) M ^INTHU(UIF,7,"MSGTYPE")=INA("MSGTYPE")
  1.  ...;Set array to pass to Output test function
  1.  ...S INREQLST(UIF)=""
  1.  ...;List the message text in expanded mode
  1.  ...I INEXPND D EXPNDIS^INTSUT1(UIF) Q:'INPOP
  1.  ...;IF there are errors, display error messages
  1.  ...D:$D(INHERR)
  1.  ....I $L($G(INHERR)) D DISPLAY^INTSUT1(INHERR,0)
  1.  ....S ERR=0
  1.  ....F  S ERR=$O(INHERR(ERR)) Q:'ERR  D DISPLAY^INTSUT1(INHERR(ERR),0)
  1.  .K ^UTILITY("INDA",$J)
  1.  .I '$G(UIF) S INMSG="Unable to create message" D DISPLAY^INTSUT1(INMSG,0)
  1.  Q
  1.  ;
  1. TEST ;Sample executable pre-processing code to test this routine
  1.  ;OUTPUT: INARY array
  1.  N INTT,INA,INDA,INHF,DIC,DA
  1.  ;Prompt for an entry to test through TEST DAVE -PARENT transaction type
  1.  S DIC="^DPT(",DIC(0)="AEZ" D ^DIC
  1.  Q:Y<0
  1.  ;Create entry in Interface Task File to test.
  1.  S INDA=+Y,INTT="TEST DAVE -PARENT"
  1.  S INA("TEST")="TEST INA",INA("HARRY")="BENCHMARK"
  1.  S INA("DMISID")=9999
  1.  S INDA(2,20)="",INDA(63,1)=""
  1.  ;Pass 7th parameter as 1 to suppress from Format Queue
  1.  D ^INHF(INTT,.INDA,.INA,"","","",1)
  1.  ;INHF will be positive if Format Task Entry is created
  1.  ;Return value in INARY to Pre-processor.
  1.  S INARY("C")=INHF
  1.  Q
  1.  ;
  1.  ;