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