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

INTSTRT.m

Go to the documentation of this file. 
  1. INTSTRT ;JD; 24 Mar 97 07:31; Routine entry for Actions on Action Bar 
  1.  ;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
  1.  ;COPYRIGHT 1991-2000 SAIC
  1.  ;This is the interactive test utility of the GIS. It is a programmer
  1.  ;utility which is run from the command prompt. There is no menu.
  1.  ;To port this to the IHS would require a screen man screen (not
  1.  ;a problem) and an interactive list manager (not available in
  1.  ;IHS). For the time being, calls to CHCS functions are commented
  1.  ;out. This will require a major revision to work for the IHS.
  1.  Q
  1. EN ;main entry point to test utility
  1.  N DWN,DIE,DWN,DIPA,DA,XGABPOP,INDA
  1.  D ENV^UTIL
  1.  ;D CLR^DIJF ;not a call for IHS
  1.  K ^UTILITY("TEST UTIL",$J,DUZ)
  1.  S DWA1="INH TEST UTILITY"
  1.  S DWLRF="^UTILITY(""TEST UTIL"",$J,DUZ)"
  1.  ;
  1.  ;D ^DWA ;Not a call for IHS
  1.  Q
  1. START(INDA) ;Start ITU from Action screen
  1.  ;Input:
  1.  ; INDA - ien of 4001.1
  1.  N INNAME,INBPNSR,INBPNAP,INTYP,DIE,INDEV,INEXPAND,INPOP,INDIR
  1.  D ^%ZIST
  1.  I '+$G(INDA) W !,"No Criteria Selected yet. Please select a Criteria",*7 Q
  1.  S DIE="^DIZ(4001.1,"
  1.  S INTYP=$$VAL^DWRA(4001.1,13.02,2,DIE,INDA)
  1.  S INEXPAND='$$VAL^DWRA(4001.1,12,2,DIE,INDA)
  1.  S INDEV=$$VAL^DWRA(4001.1,28,2,DIE,INDA) S:INDEV="" INDEV=$I
  1.  S INDIR=$$VAL^DWRA(4001.1,6,2,DIE,INDA)
  1.  ;Get message list
  1.  W $$SETXY^%ZTF(0,21),"Stop -- Press any key to stop",@DIJC("EOL")
  1.  W $$SETXY^%ZTF(0,22),@DIJC("EOL")
  1.  D SCR^INTSUT1(5,17)
  1.  ;If Query response message
  1.  I INTYP="Q" D
  1.  .D ZIS^INHUT8("QUERY^INTSTRT1(INDA,.DIPA,INEXPAND)","INDA^DIPA(^INEXPAND^",1,"","",INDEV)
  1.  .D LISTMSG^INTSTRT1(DIPA("DA"))
  1.  ;If unsolicited message
  1.  I INTYP="U" D UNSOLI^INTSTRT1(INDIR,.DIPA,INEXPAND,INDA,DIE)
  1.  ;If unit test
  1.  I INTYP="T" D UNIT^INTSTRT1(INDA,INDIR,INEXPAND)
  1.  Q
  1. LSTHDR(INDA) ;Header for Command screen processor
  1.  ;Input:
  1.  ; INDA - ien of 4001.1
  1.  N INX,INDIR,DIE,INTCNAM,INST
  1.  S INX="Interface Testing Utilities Monitor"
  1.  W $$SETXY^%ZTF(0,0),INX_$$PAD^INHUT2($$CDATASC^%ZTFDT($H,1,3),80-$L(INX)," ")
  1.  I '+$G(INDA) W !!,"No Criteria Selected" Q
  1.  E  D
  1.  .S DIE="^DIZ(4001.1,"
  1.  .S INTCNAM=$$VAL^DWRA(4001.1,".04",2,DIE,INDA)
  1.  .S:INTCNAM="" INTCNAM="  (No Test Case Name defined)"
  1.  .S INDIR=$$VAL^DWRA(4001.1,6,2,DIE,INDA),INDIR=$S(INDIR="O":"Outbound",INDIR="I":"Inbound",1:"")
  1.  .S:INDIR="" INDIR=" (None)"
  1.  .W !!,?10,"Test Case: ",INTCNAM,?57,"Direction: ",INDIR
  1.  .S INST=$$VAL^DWRA(4001.1,13.07,2,DIE,INDA)
  1.  .S INST=$S(INST="F":"Format Controller",INST="O":"Output Controller",1:"")
  1.  .W !,?2,"Starting Process: ",INST
  1.  Q
  1. CRIT(DIPA,INDA) ;go to criteria gallery from action screen
  1.  ;Input/Output
  1.  ; DIPA - Array with DIPA("DA")
  1.  ; INDA - ien of criteria
  1.  N DWN,DWLRF,DWA1,DWLM,INX,X,Y,INNAME,INOPT,INDEV,INODA
  1.  S INODA=$G(DIPA("DA"))
  1.  S:INODA INOPT("NAME")=INODA
  1.  S INOPT("GALLERY")="INH TEST UTILITY CRITERIA",INOPT("LOCK")=1,INOPT("TYPE")="TEST",INOPT("NEW")=1
  1.  W @IOF
  1.  S Y=$$GETCRIT^INHUTC(.INOPT,.INPARMS)
  1.  I +Y>0 S (INDA,DIPA("DA"))=+Y I $G(INODA),$$LOCK^INHUTC(INODA,0)
  1.  I '+Y D
  1.  .K INDA,DIPA("DA")
  1.  .S:INODA (INDA,DIPA("DA"))=INODA
  1.  ;;D CLR^DIJF ;;Not an IHS call
  1.  Q
  1. SAVE(INDA) ;Save an element to flat file from the action screen
  1.  ; Input:
  1.  ;   INDA - ien of 4001.1 entry to save
  1.  N DIE,DIC,X,Y,INNTRIES,I,INTMP,%FILE,%OIEN,INRTN,INPOP,INAME,INROU,INCR
  1.  N INOMIT
  1.  I '+$G(INDA) W *7 Q
  1.  ;validate all pointers to ^INTHU exist
  1.  D UPDTSND^INTSUT3(INDA) K ^DIZ(4001.1,INDA,19) D UPDTFRUT^INTSUT3(INDA)
  1.  S (INCR,INPOP)=0
  1.  S INAME=$$VAL^DWRA("4001.1",18.05,2,"^DIZ(4001.1,",+$G(INDA))
  1.  S INAME=$$FLATNAM^INTSUT3(INAME,"S")
  1.  Q:INAME=""
  1.  K ^UTILITY($J)
  1.  S INNTRIES("4001.1",INDA)=""
  1.  ;Omit pointed to UIF fields in Universal Interface file
  1.  F I=".06",".07",".18" S INOMIT(4001,I)=""
  1.  S I=0 F  S I=$O(^DIZ(4001.1,INDA,19,I)) Q:'I  D
  1.  .S INTMP=$G(^DIZ(4001.1,INDA,19,I,0))
  1.  .I INTMP S INNTRIES(4001,+INTMP)=""
  1.  S %FILE="" F  S %FILE=$O(INNTRIES(%FILE)) Q:%FILE=""  D
  1.  .S %OIEN="" F  S %OIEN=$O(INNTRIES(%FILE,%OIEN)) Q:%OIEN=""  D
  1.  ..D COPY^INHSYS09(%FILE,%OIEN,0,.INOMIT)
  1.  Q:'$D(^UTILITY($J))
  1.  W !
  1.  D SV2FLT^INHSYSE(INAME,.INDONE)
  1.  I 'INDONE W !,"Save did not complete. Check validity of file name.",*7,$$CR^UTSRD(0,21)
  1.  Q
  1. RESTORE(INDA,DIPA) ;Restore data from flat file from the action Screen
  1.  ;Input:
  1.  ; INDA - ien of 4001.1 entry to restore 
  1.  ; DIPA - array of saved variables
  1.  N DIE,DIC,DR,X,INAME,INRTN,INREPRT,%DRVR,Y,IN01,INCRNAM,%
  1.  N %PASS,%LFILES,AA,%SAV,DFN,INMSG,DONE,INEX,INODA,INOPT,INEWDA
  1.  S INREPRT=0
  1.  S INAME=$$VAL^DWRA("4001.1",18.05,2,"^DIZ(4001.1,",+$G(INDA))
  1.  S INAME=$$FLATNAM^INTSUT3(INAME)
  1.  Q:INAME=""
  1.  W !
  1.  K ^UTILITY("INHSYS",$J)
  1.  D RSFRFLT^INHSYSE(INAME)
  1.  I '$D(^UTILITY("INHSYS",$J)) D MSG^INTSUT2("Nothing updated. Check validity of VMS file") S X=$$CR^UTSRD Q
  1.  I $D(^UTILITY("INHSYS",$J)),$$CONTINUE^INTSTRT1($G(^UTILITY("INHSYS",$J,4001.1,+$O(^UTILITY("INHSYS",$J,4001.1,"")),0))) D
  1.  .D CRDUZ^INTSTRT1
  1.  .S INODA=+$G(INDA)
  1.  .W !,"." D INST^INHSYSE(.%DRVR,2,INREPRT,.INFLD,.INMSG)
  1.  .S INOPT("TYPE")="TEST",INOPT("LOCK")=0,INOPT("NONINTER")=1
  1.  .W "." S INEWDA=$$SAVE^INHUTC1(.INOPT,DIPA("DA"),"U")
  1.  .S INOPT("LOCK",INODA)=$G(INOPT("LOCK",INODA))+1
  1.  .D UNLOCK^INTSTRT1(INEWDA,.INOPT)
  1.  .I 'INEWDA,$L(INEWDA)>1 W !,INEWDA S X=$$CR^UTSRD Q
  1.  .S (DIPA("DA"),INDA)=+INEWDA
  1.  ;Clean up ^UTILITY
  1.  K ^UTILITY($J),^UTILITY("INHSYS",$J),^UTILITY("INHSYSUT",$J)
  1.  Q
  1. HELP ;Action Screen Help
  1.  W !,"Start/Stop - Start or Stop transmission or reception of messages."
  1.  W !,"Criteria   - Select a criteria and edit it."
  1.  W !,"Listmsg    - List the selected messages to be transmitted."
  1.  W !,"selMsg     - Select messages from the Universal Interface file to "
  1.  W !,"             transmit to the interface."
  1.  W !,"saVe       - Save the test criteria to a flat file."
  1.  W !,"Restore    - Restore test criteria from a flat file."
  1.  W !,"eXit       - Exit the Test Utility Monitor"
  1.  W !!!,"***   See GIS manual for additional Interactive Test Utility Help"
  1.  Q
  1. SEL(INDA) ;Select messages from selMsg on the Action Screen
  1.  ; DESCRIPTION: Prompts the user for a message to select. The user may
  1.  ;              enter any valid indexed message for a single
  1.  ;              message or '/' to search and select multiple messages.
  1.  ;Input: 
  1.  ; INDA - ien of Criteria
  1.  ;Output:
  1.  ;  ^UTILITY("INTHU",DUZ,$J,INL,IND) - Messages to send
  1.  ;
  1.  N X,Y,INNDA,INPARM2,DIC,I,POP,INLOOP,INDA1,INOPT,INREQLST,DIE
  1.  I '+$G(INDA) W *7 Q
  1.  ; construct the structure defining the selection operations
  1.  I '$O(^INTHU(0)) W !!,"There are no entries to select." Q
  1.  ;
  1.  ;Determine how to search
  1.  F  D  Q:X[U!(X="")!(X="C")!(X="c")!(X="I")!(X="i")  W *7
  1.  .D HDR^INTS
  1.  .W ! S X=$$READ^%ZTF(1,2,"(C)andidate Search or (I)ndividual Messages: ","C",13)
  1.  Q:X[U!(X="")
  1.  ;
  1.  ;Message search
  1.  I X="/"!(X="C")!(X="c") D  Q
  1.  .S INDA1=INDA
  1.  .S INOPT("ARRAY")="INREQLST"
  1.  .D ENTRY^INHUTC("TRANSACTION","INTERFACE","","",.INOPT)
  1.  .S (INDA,DIPA("DA"))=INDA1
  1.  .S INL="" F  S INL=$O(INREQLST(INL)) Q:INL=""  D
  1.  ..S INT=INREQLST(INL)
  1.  ..;update 4001.1 
  1.  ..D UPSINGMS^INTSUT3(INDA1,"LS",INT)
  1.  .;if we added something update utility
  1.  .I $O(INREQLST("")) D UPDTSND^INTSUT3(INDA1)
  1.  .S INOPT("TYPE")="TEST",INOPT("NONINTER")=1,X=$$SAVE^INHUTC1(.INOPT,INDA1,"U")
  1.  .I 'X,$L(X)>1 W !,X S X=$$CR^UTSRD
  1.  .S (INDA,DIPA("DA"))=INDA1
  1.  .;D CLR^DIJF ;not an IHS call
  1.  ;
  1.  ;Allow multiple DIC selections
  1.  K INREQLST
  1.  ;I '$D(^DIZ(4001.1,INDA,19,0)) S ^DIZ(4001.1,INDA,19,0)="^4001.19PA"
  1.  K DIC S DIC("P")=$P(^DD(4001.1,19,0),U,2),DIC="^DIZ(4001.1,"_INDA_",19,",DIC(0)="ANMEQL",DA(1)=INDA,DIE=DIC
  1.  F  D ^DIC Q:Y<0  D
  1.  .N DIC,X,DA,DR
  1.  .S DA=+Y,DA(1)=INDA,DR=".01//^S X=""`"""_$P(Y,U,2)
  1.  .;call DIE to give ability to delete
  1.  .D ^DIE
  1.  S DIPA("DA")=INDA
  1.  S INOPT("TYPE")="TEST",INOPT("NONINTER")=1
  1.  S X=$$SAVE^INHUTC1(.INOPT,DIPA("DA"),"U")
  1.  I 'X,$L(X)>1 W !,X S X=$$CR^UTSRD
  1.  Q
  1. DIS(INDA) ;Display current messages from Listmsg on the action screen
  1.  ;Input:
  1.  ; INDA - ien of Criteria
  1.  N INL,INTN,DWL,DWLRF,DWLB,INCNT,INODE0,Y,DWLMK,INTMP
  1.  K ^UTILITY("DIS",$J)
  1.  I '+$G(INDA) W *7 Q
  1.  D UPDATE^INTSUT3(INDA)
  1.  S INCNT=0
  1.  S INL=0 F  S INL=$O(^UTILITY("DIS",$J,INL)) Q:'INL  D
  1.  .S IND=0 F  S IND=$O(^UTILITY("DIS",$J,INL,IND)) Q:'IND  D
  1.  ..S INCNT=INCNT+1
  1.  ..S INODE0=$G(^UTILITY("DIS",$J,INL,IND,0))
  1.  ..S Y=$$PAR^%DT($P(INODE0,U))
  1.  ..S INTMP=Y_"             "
  1.  ..S INTMP=$E(INTMP,1,22)_$P(INODE0,U,5)_"                        "
  1.  ..S ^UTILITY("DIS",$J,INCNT)=$E(INTMP,1,44)_$P($G(^INRHD(+$P(INODE0,U,2),0)),U)
  1.  ..S ^UTILITY("DIS",$J,INCNT,0)=""
  1.  ..S ^UTILITY("DIS",$J,INCNT,"IEN")=IND
  1.  I '$D(^UTILITY("DIS",$J)) D
  1.  .S ^UTILITY("DIS",$J,1)="No messages selected for this criteria yet"
  1.  .S ^UTILITY("DIS",$J,1,0)=""
  1.  S DWL="XWFE",DWLRF="^UTILITY(""DIS"","_$J_")",DWLB="0^3^17^78"
  1.  S INTIT="Test Utility Messages to be Transmitted List"
  1.  S DWL("TITLE")="W $$CENTER^INHUTIL(INTIT,IOM),!!,?2,""Date/Time"",?24,""Message ID"",?46,""Destination"""
  1.  F  D ^DWL Q:DWLR'="E"  D DISPEXP^INTSUT1(.DWLRF)
  1.  D:$D(DWLMK)>1 DISPEXP^INTSUT1(.DWLMK)
  1.  K ^UTILITY("DIS",$J)
  1.  Q
  1. EXIT(INDA) ;Exit from action screen
  1.  ;Input:
  1.  ; INDA - IEN of Criteria
  1.  N INIPPO,X,INBPN
  1.  S X=$$LOCK^INHUTC(.INDA,"-")
  1.  Q