INTSUT1 ;JPD; 6 May 98 09:20; Utility routine
;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
;COPYRIGHT 1991-2000 SAIC
;
Q
SETSCR(INDA,DIE,INVAL,INREV,DWSFLD) ;initialize fields in second windowman
;screen called from post action of field 20 and field 18.03 in windowman
; gallery
;Input:
; INDA - ien of 4001.1
; DIE - 4001.1
; INVAL - field number from 4001.1 of background process
; INREV - 1 - Reverse from client to server or server to client
; 0 - Don't reverse
;Output:
; DWSFLD - Windowman values
;
N INBPN,I,IN0,IN1,INIP
;clear out values of Test Parameters
F I=16.01,16.02,16.03,16.05,16.06,16.07,16.08,16.09,16.1,16.11,16.12,17.01,17.02,23.01 S DWSFLD(I)="@"
;unsolicited inbound set transaction type or Query response
I ($$VAL^DWRA(4001.1,6,0,DIE,INDA)="I"&($$VAL^DWRA(4001.1,"13.02",0,DIE,INDA)="U"))!($$VAL^DWRA(4001.1,"13.02",0,DIE,INDA)="Q") S DWSFLD(13.01)="HL GIS ACCEPT ACKNOWLEDGEMENT"
S INVAL=+$G(INVAL)
;set background process
S INBPN=+$$VAL^DWRA(4001.1,INVAL,0,DIE,INDA)
;Default read, hang and transmit retries
D INIT^INHUVUT(INBPN,.INIP)
;
;Open Hang Open retries
S DWSFLD(16.03)=INIP("OHNG"),DWSFLD(16.04)=INIP("OTRY")
;Transmitter Hang
S DWSFLD(16.05)=INIP("THNG")
;Send Hang, Send retry, Send Timeout
S DWSFLD(16.06)=INIP("SHNG"),DWSFLD(16.07)=INIP("STRY"),DWSFLD(16.08)=INIP("STO")
;Read hand, Read Retry, Read Tiemout
S DWSFLD(16.09)=INIP("RHNG"),DWSFLD(16.1)=INIP("RTRY"),DWSFLD(16.11)=INIP("RTO")
S IN0=$G(^INTHPC(INBPN,0)),IN1=$G(^INTHPC(INBPN,1))
;Set Client/Server Flag
S DWSFLD(13.03)=$P(IN0,U,8)
I INREV,DWSFLD(13.03)'="" S DWSFLD(13.03)='DWSFLD(13.03)
;
;if remote is client set to server
I INREV,DWSFLD(13.03)=1 D
.;Set server port by getting clients IP port
.S I=0 F S I=$O(^INTHPC(INBPN,6,I)) Q:'I D Q:DWSFLD(16.02)
..S J=0 F S J=$O(^INTHPC(INBPN,6,I,1,J)) Q:'J D
...S DWSFLD(16.02)=$G(^INTHPC(INBPN,6,I,1,J,0))
;
;If remote is server and current type not Query response
I INREV,DWSFLD(13.03)=0,$$VAL^DWRA(4001.1,"13.02",0,DIE,INDA)'="Q" D
.;set client address
.S DWSFLD(16.01)="127.0.0.1"
.;set client port
.S I=$O(^INTHPC(INBPN,5,0))
.S DWSFLD(16.02)=$G(^INTHPC(INBPN,5,+I,0))
;If query response and current BP is a server set to same port
I $$VAL^DWRA(4001.1,"13.02",0,DIE,INDA)="Q",DWSFLD(13.03)=1 D
.S I=$O(^INTHPC(INBPN,5,0))
.S DWSFLD(16.02)=$G(^INTHPC(INBPN,5,+I,0))
;End of Line
S DWSFLD(16.12)=$P(IN1,U,7)
;Client Init String
S DWSFLD(17.01)=$P(IN1,U,8)
;Init Response
S DWSFLD(17.02)=$P(IN1,U,9)
S (DWSFLD(17.03,0),DWSFLD(18.01,0),DWSFLD(18.02,0))=2
Q
SCR2(DWSFLD) ;second screen pre check
;Input:
; DWSFLD - Windowman array
;
I $$VAL^DWRA("4001.1","13.02",1,DIE,INDA)="U" D
.S (DWSFLD(18.01,0),DWSFLD(18.02,0),DWSFLD(17.03,0))=2
I $$VAL^DWRA("4001.1","13.02",1,DIE,INDA)="Q" D
.S (DWSFLD(18.01,0),DWSFLD(18.02,0),DWSFLD(17.03,0))=0
Q
SCR2APP(DWSFLD,INDA) ;App server second screen
;Input:
; DWSFLD - Windowman array
; INDA -ien of criteria
;
N INBPNAP
S INBPNAP=+$$VAL^DWRA(4001.1,18.04,0,DIE,INDA)
I INBPNAP,$$VAL^DWRA(4001.1,17.03,0,DIE,INDA)="" S DWSFLD(17.03)=$P($G(^INTHPC(INBPNAP,7)),U,4)
;set local address
S DWSFLD(18.01)="127.0.0.1"
;set port
S DWSFLD(18.02)="AUTO GENERATE"
Q
DEFRHT(DWSFLD,INBPN) ;Set Default hang, retry and transmit values
;Input:
; DWSFLD - Gallery variable
N INIP
D INIT^INHUVUT(INBPN,.INIP)
;
;Open Hang Open retries
S DWSFLD(16.03)=INIP("OHNG"),DWSFLD(16.04)=INIP("OTRY")
;Transmitter Hang
S DWSFLD(16.05)=INIP("THNG")
;Send Hang, Send retry, Send Timeout
S DWSFLD(16.06)=INIP("SHNG"),DWSFLD(16.07)=INIP("STRY"),DWSFLD(16.08)=INIP("STO")
;Read hand, Read Retry, Read Tiemout
S DWSFLD(16.09)=INIP("RHNG"),DWSFLD(16.1)=INIP("RTRY"),DWSFLD(16.11)=INIP("RTO")
Q
DISPLAY(MS,INDIS,INUIF) ;Write interactive messages to the screen
;INPUT:
; MS - message to display
; INDIS - 0 display to screen, 1 don't display to screen
; INUIF opt - ien of Universal Interface File
;OUTPUT:
; INPOP - exit simulator
N J
S MS=$G(MS),INDIS=+$G(INDIS),INPOP=+$G(INPOP),INUIF=+$G(INUIF)
I 'INDIS D
.U 0 W !,MS
.I $S(IO'=IO(0):1,1:0) U IO W !,MS
.S (J,^UTILITY("DIS",$J))=+$G(^UTILITY("DIS",$J))+1
.S ^UTILITY("DIS",$J,J)=MS
.I $D(^INTHU(INUIF,0)) D
..S ^UTILITY("DIS",$J,J,0)=""
..S ^UTILITY("DIS",$J,J,"IEN")=INUIF
U 0 R *X:0
I X'=-1 S INPOP=0
Q:'$G(INIPPO)!'$G(INBPN)
I 'INPOP D Q
.I $S(IO'=IO(0):1,1:0) U IO W !,"Process signalled to terminate",!
.S MS="Process signalled to terminate"
.U 0 W !,MS,!
.S (J,^UTILITY("DIS",$J))=+$G(^UTILITY("DIS",$J))+1
.S ^UTILITY("DIS",$J,J)=MS
S ^INRHB("RUN","SRVR",INBPN,INIPPO)=$H_U_MS
Q
DISONE(IND,IOM) ;display one message
; Input:
; IND - Node to parse
; IOM - Margin of display
N INMS,J,MS,INMSA
S INMS="INMSA"
D ONE^INHUT9(IND,.INMS,IOM,3,"|CR|")
S J=0 F S J=$O(@INMS@(J)) Q:'J S MS=@INMS@(J) D:$L(MS) DISPLAY^INTSUT1(MS,INEXPAND)
I INMS["^" K @INMS
Q
SCR(IOYF,IOYT,INFR) ;position screen scrolling region
;Input:
; IOYF - scrolling region start position
; IOYT - scrolling region end position
; INFR - display frame
N DIJC,INA,I
S INFR=$G(INFR)
I $G(DIJTT)'="" S INA="GO^DIJS"_DIJTT D @INA
X DIJC("SCR")
I INFR W $$SETXY^%ZTF(0,4),DIJC("BXT")
F I=6:1:18 W $$SETXY^%ZTF(0,I),@DIJC("EOL")
I INFR W $$SETXY^%ZTF(0,20),DIJC("BXB")
W $$SETXY^%ZTF(0,6)
Q
EXPNDIS(INUIF) ;Display expanded message and store
;Input:
; INUIF - Universal Interface file ien
N INMS,MS,J,INMSA
S INMS="INMSA"
D ONE^INHUT9("^INTHU("_INUIF_",3,0)",.INMS,78,3,"|CR|",1)
S J=0 F S J=$O(@INMS@(J)) Q:'J S MS=@INMS@(J) D:$L(MS) DISPLAY(MS,0,INUIF)
I INMS["^" K @INMS
Q
DISPEXP(DWLMK) ;display expanded list
;Input:
; DWLMK - Array of Listman selected values
N DA,DHD,DIC,DIPA,DR,IO,ION,IOST,IOM,IOSL,INIOP,INUIF,INIO,POP,%ZIS,X,Y
N INT
I $D(DWLMK)=1,+$G(^UTILITY("DIS",$J,+$P(@DWLMK,U,4),"IEN"))=0 Q
;loop and look for a selected message that has a UIF entry quit if none
S (INUIF,INT)=""
I $D(DWLMK)'=1 D Q:'INUIF
.F S INT=$O(DWLMK(INT)) Q:INT="" D Q:INUIF
..S INUIF=+$G(^UTILITY("DIS",$J,INT,"IEN"))
D CLEAR^DW
S %ZIS="N" D ^%ZIS Q:POP S INIO=IO,IOP=ION_";"_IOST_";"_IOM_";"_IOSL
S INIOP=IOP
I $D(DWLMK)=1 D Q
.S INUIF=+$G(^UTILITY("DIS",$J,+$P(@DWLMK,U,4),"IEN"))
.Q:'INUIF
.S DA(INUIF)=""
.S IOP=INIOP,DIC=4001,DHD="@",DR="INH MESSAGE DISPLAY"
.D PRTLIST^DWPR
.S:INIO=IO X=$$CR^UTSRD
S INT="" F S INT=$O(DWLMK(INT)) Q:INT="" D
.S INUIF=+$G(^UTILITY("DIS",$J,INT,"IEN"))
.Q:'INUIF
.S IOP=INIOP
.S DIC=4001,DHD="@",DR="INH MESSAGE DISPLAY"
.S DA(INUIF)=""
.D PRTLIST^DWPR
S:INIO=IO X=$$CR^UTSRD
Q
INTSUT1 ;JPD; 6 May 98 09:20; Utility routine
+1 ;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
+2 ;COPYRIGHT 1991-2000 SAIC
+3 ;
+4 QUIT
SETSCR(INDA,DIE,INVAL,INREV,DWSFLD) ;initialize fields in second windowman
+1 ;screen called from post action of field 20 and field 18.03 in windowman
+2 ; gallery
+3 ;Input:
+4 ; INDA - ien of 4001.1
+5 ; DIE - 4001.1
+6 ; INVAL - field number from 4001.1 of background process
+7 ; INREV - 1 - Reverse from client to server or server to client
+8 ; 0 - Don't reverse
+9 ;Output:
+10 ; DWSFLD - Windowman values
+11 ;
+12 NEW INBPN,I,IN0,IN1,INIP
+13 ;clear out values of Test Parameters
+14 FOR I=16.01,16.02,16.03,16.05,16.06,16.07,16.08,16.09,16.1,16.11,16.12,17.01,17.02,23.01
SET DWSFLD(I)="@"
+15 ;unsolicited inbound set transaction type or Query response
+16 IF ($$VAL^DWRA(4001.1,6,0,DIE,INDA)="I"&($$VAL^DWRA(4001.1,"13.02",0,DIE,INDA)="U"))!($$VAL^DWRA(4001.1,"13.02",0,DIE,INDA)="Q")
SET DWSFLD(13.01)="HL GIS ACCEPT ACKNOWLEDGEMENT"
+17 SET INVAL=+$GET(INVAL)
+18 ;set background process
+19 SET INBPN=+$$VAL^DWRA(4001.1,INVAL,0,DIE,INDA)
+20 ;Default read, hang and transmit retries
+21 DO INIT^INHUVUT(INBPN,.INIP)
+22 ;
+23 ;Open Hang Open retries
+24 SET DWSFLD(16.03)=INIP("OHNG")
SET DWSFLD(16.04)=INIP("OTRY")
+25 ;Transmitter Hang
+26 SET DWSFLD(16.05)=INIP("THNG")
+27 ;Send Hang, Send retry, Send Timeout
+28 SET DWSFLD(16.06)=INIP("SHNG")
SET DWSFLD(16.07)=INIP("STRY")
SET DWSFLD(16.08)=INIP("STO")
+29 ;Read hand, Read Retry, Read Tiemout
+30 SET DWSFLD(16.09)=INIP("RHNG")
SET DWSFLD(16.1)=INIP("RTRY")
SET DWSFLD(16.11)=INIP("RTO")
+31 SET IN0=$GET(^INTHPC(INBPN,0))
SET IN1=$GET(^INTHPC(INBPN,1))
+32 ;Set Client/Server Flag
+33 SET DWSFLD(13.03)=$PIECE(IN0,U,8)
+34 IF INREV
IF DWSFLD(13.03)'=""
SET DWSFLD(13.03)='DWSFLD(13.03)
+35 ;
+36 ;if remote is client set to server
+37 IF INREV
IF DWSFLD(13.03)=1
Begin DoDot:1
+38 ;Set server port by getting clients IP port
+39 SET I=0
FOR
SET I=$ORDER(^INTHPC(INBPN,6,I))
IF 'I
QUIT
Begin DoDot:2
+40 SET J=0
FOR
SET J=$ORDER(^INTHPC(INBPN,6,I,1,J))
IF 'J
QUIT
Begin DoDot:3
+41 SET DWSFLD(16.02)=$GET(^INTHPC(INBPN,6,I,1,J,0))
End DoDot:3
End DoDot:2
IF DWSFLD(16.02)
QUIT
End DoDot:1
+42 ;
+43 ;If remote is server and current type not Query response
+44 IF INREV
IF DWSFLD(13.03)=0
IF $$VAL^DWRA(4001.1,"13.02",0,DIE,INDA)'="Q"
Begin DoDot:1
+45 ;set client address
+46 SET DWSFLD(16.01)="127.0.0.1"
+47 ;set client port
+48 SET I=$ORDER(^INTHPC(INBPN,5,0))
+49 SET DWSFLD(16.02)=$GET(^INTHPC(INBPN,5,+I,0))
End DoDot:1
+50 ;If query response and current BP is a server set to same port
+51 IF $$VAL^DWRA(4001.1,"13.02",0,DIE,INDA)="Q"
IF DWSFLD(13.03)=1
Begin DoDot:1
+52 SET I=$ORDER(^INTHPC(INBPN,5,0))
+53 SET DWSFLD(16.02)=$GET(^INTHPC(INBPN,5,+I,0))
End DoDot:1
+54 ;End of Line
+55 SET DWSFLD(16.12)=$PIECE(IN1,U,7)
+56 ;Client Init String
+57 SET DWSFLD(17.01)=$PIECE(IN1,U,8)
+58 ;Init Response
+59 SET DWSFLD(17.02)=$PIECE(IN1,U,9)
+60 SET (DWSFLD(17.03,0),DWSFLD(18.01,0),DWSFLD(18.02,0))=2
+61 QUIT
SCR2(DWSFLD) ;second screen pre check
+1 ;Input:
+2 ; DWSFLD - Windowman array
+3 ;
+4 IF $$VAL^DWRA("4001.1","13.02",1,DIE,INDA)="U"
Begin DoDot:1
+5 SET (DWSFLD(18.01,0),DWSFLD(18.02,0),DWSFLD(17.03,0))=2
End DoDot:1
+6 IF $$VAL^DWRA("4001.1","13.02",1,DIE,INDA)="Q"
Begin DoDot:1
+7 SET (DWSFLD(18.01,0),DWSFLD(18.02,0),DWSFLD(17.03,0))=0
End DoDot:1
+8 QUIT
SCR2APP(DWSFLD,INDA) ;App server second screen
+1 ;Input:
+2 ; DWSFLD - Windowman array
+3 ; INDA -ien of criteria
+4 ;
+5 NEW INBPNAP
+6 SET INBPNAP=+$$VAL^DWRA(4001.1,18.04,0,DIE,INDA)
+7 IF INBPNAP
IF $$VAL^DWRA(4001.1,17.03,0,DIE,INDA)=""
SET DWSFLD(17.03)=$PIECE($GET(^INTHPC(INBPNAP,7)),U,4)
+8 ;set local address
+9 SET DWSFLD(18.01)="127.0.0.1"
+10 ;set port
+11 SET DWSFLD(18.02)="AUTO GENERATE"
+12 QUIT
DEFRHT(DWSFLD,INBPN) ;Set Default hang, retry and transmit values
+1 ;Input:
+2 ; DWSFLD - Gallery variable
+3 NEW INIP
+4 DO INIT^INHUVUT(INBPN,.INIP)
+5 ;
+6 ;Open Hang Open retries
+7 SET DWSFLD(16.03)=INIP("OHNG")
SET DWSFLD(16.04)=INIP("OTRY")
+8 ;Transmitter Hang
+9 SET DWSFLD(16.05)=INIP("THNG")
+10 ;Send Hang, Send retry, Send Timeout
+11 SET DWSFLD(16.06)=INIP("SHNG")
SET DWSFLD(16.07)=INIP("STRY")
SET DWSFLD(16.08)=INIP("STO")
+12 ;Read hand, Read Retry, Read Tiemout
+13 SET DWSFLD(16.09)=INIP("RHNG")
SET DWSFLD(16.1)=INIP("RTRY")
SET DWSFLD(16.11)=INIP("RTO")
+14 QUIT
DISPLAY(MS,INDIS,INUIF) ;Write interactive messages to the screen
+1 ;INPUT:
+2 ; MS - message to display
+3 ; INDIS - 0 display to screen, 1 don't display to screen
+4 ; INUIF opt - ien of Universal Interface File
+5 ;OUTPUT:
+6 ; INPOP - exit simulator
+7 NEW J
+8 SET MS=$GET(MS)
SET INDIS=+$GET(INDIS)
SET INPOP=+$GET(INPOP)
SET INUIF=+$GET(INUIF)
+9 IF 'INDIS
Begin DoDot:1
+10 USE 0
WRITE !,MS
+11 IF $SELECT(IO'=IO(0):1,1:0)
USE IO
WRITE !,MS
+12 SET (J,^UTILITY("DIS",$JOB))=+$GET(^UTILITY("DIS",$JOB))+1
+13 SET ^UTILITY("DIS",$JOB,J)=MS
+14 IF $DATA(^INTHU(INUIF,0))
Begin DoDot:2
+15 SET ^UTILITY("DIS",$JOB,J,0)=""
+16 SET ^UTILITY("DIS",$JOB,J,"IEN")=INUIF
End DoDot:2
End DoDot:1
+17 USE 0
READ *X:0
+18 IF X'=-1
SET INPOP=0
+19 IF '$GET(INIPPO)!'$GET(INBPN)
QUIT
+20 IF 'INPOP
Begin DoDot:1
+21 IF $SELECT(IO'=IO(0):1,1:0)
USE IO
WRITE !,"Process signalled to terminate",!
+22 SET MS="Process signalled to terminate"
+23 USE 0
WRITE !,MS,!
+24 SET (J,^UTILITY("DIS",$JOB))=+$GET(^UTILITY("DIS",$JOB))+1
+25 SET ^UTILITY("DIS",$JOB,J)=MS
End DoDot:1
QUIT
+26 SET ^INRHB("RUN","SRVR",INBPN,INIPPO)=$HOROLOG_U_MS
+27 QUIT
DISONE(IND,IOM) ;display one message
+1 ; Input:
+2 ; IND - Node to parse
+3 ; IOM - Margin of display
+4 NEW INMS,J,MS,INMSA
+5 SET INMS="INMSA"
+6 DO ONE^INHUT9(IND,.INMS,IOM,3,"|CR|")
+7 SET J=0
FOR
SET J=$ORDER(@INMS@(J))
IF 'J
QUIT
SET MS=@INMS@(J)
IF $LENGTH(MS)
DO DISPLAY^INTSUT1(MS,INEXPAND)
+8 IF INMS["^"
KILL @INMS
+9 QUIT
SCR(IOYF,IOYT,INFR) ;position screen scrolling region
+1 ;Input:
+2 ; IOYF - scrolling region start position
+3 ; IOYT - scrolling region end position
+4 ; INFR - display frame
+5 NEW DIJC,INA,I
+6 SET INFR=$GET(INFR)
+7 IF $GET(DIJTT)'=""
SET INA="GO^DIJS"_DIJTT
DO @INA
+8 XECUTE DIJC("SCR")
+9 IF INFR
WRITE $$SETXY^%ZTF(0,4),DIJC("BXT")
+10 FOR I=6:1:18
WRITE $$SETXY^%ZTF(0,I),@DIJC("EOL")
+11 IF INFR
WRITE $$SETXY^%ZTF(0,20),DIJC("BXB")
+12 WRITE $$SETXY^%ZTF(0,6)
+13 QUIT
EXPNDIS(INUIF) ;Display expanded message and store
+1 ;Input:
+2 ; INUIF - Universal Interface file ien
+3 NEW INMS,MS,J,INMSA
+4 SET INMS="INMSA"
+5 DO ONE^INHUT9("^INTHU("_INUIF_",3,0)",.INMS,78,3,"|CR|",1)
+6 SET J=0
FOR
SET J=$ORDER(@INMS@(J))
IF 'J
QUIT
SET MS=@INMS@(J)
IF $LENGTH(MS)
DO DISPLAY(MS,0,INUIF)
+7 IF INMS["^"
KILL @INMS
+8 QUIT
DISPEXP(DWLMK) ;display expanded list
+1 ;Input:
+2 ; DWLMK - Array of Listman selected values
+3 NEW DA,DHD,DIC,DIPA,DR,IO,ION,IOST,IOM,IOSL,INIOP,INUIF,INIO,POP,%ZIS,X,Y
+4 NEW INT
+5 IF $DATA(DWLMK)=1
IF +$GET(^UTILITY("DIS",$JOB,+$PIECE(@DWLMK,U,4),"IEN"))=0
QUIT
+6 ;loop and look for a selected message that has a UIF entry quit if none
+7 SET (INUIF,INT)=""
+8 IF $DATA(DWLMK)'=1
Begin DoDot:1
+9 FOR
SET INT=$ORDER(DWLMK(INT))
IF INT=""
QUIT
Begin DoDot:2
+10 SET INUIF=+$GET(^UTILITY("DIS",$JOB,INT,"IEN"))
End DoDot:2
IF INUIF
QUIT
End DoDot:1
IF 'INUIF
QUIT
+11 DO CLEAR^DW
+12 SET %ZIS="N"
DO ^%ZIS
IF POP
QUIT
SET INIO=IO
SET IOP=ION_";"_IOST_";"_IOM_";"_IOSL
+13 SET INIOP=IOP
+14 IF $DATA(DWLMK)=1
Begin DoDot:1
+15 SET INUIF=+$GET(^UTILITY("DIS",$JOB,+$PIECE(@DWLMK,U,4),"IEN"))
+16 IF 'INUIF
QUIT
+17 SET DA(INUIF)=""
+18 SET IOP=INIOP
SET DIC=4001
SET DHD="@"
SET DR="INH MESSAGE DISPLAY"
+19 DO PRTLIST^DWPR
+20 IF INIO=IO
SET X=$$CR^UTSRD
End DoDot:1
QUIT
+21 SET INT=""
FOR
SET INT=$ORDER(DWLMK(INT))
IF INT=""
QUIT
Begin DoDot:1
+22 SET INUIF=+$GET(^UTILITY("DIS",$JOB,INT,"IEN"))
+23 IF 'INUIF
QUIT
+24 SET IOP=INIOP
+25 SET DIC=4001
SET DHD="@"
SET DR="INH MESSAGE DISPLAY"
+26 SET DA(INUIF)=""
+27 DO PRTLIST^DWPR
End DoDot:1
+28 IF INIO=IO
SET X=$$CR^UTSRD
+29 QUIT
