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

INTSUT1.m

Go to the documentation of this file. 
  1. INTSUT1 ;JPD; 6 May 98 09:20; Utility routine 
  1.  ;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
  1.  ;COPYRIGHT 1991-2000 SAIC
  1.  ;
  1.  Q
  1. 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
  1.  ; gallery
  1.  ;Input:
  1.  ;  INDA - ien of 4001.1
  1.  ;   DIE - 4001.1
  1.  ; INVAL - field number from 4001.1 of background process
  1.  ; INREV - 1 - Reverse from client to server or server to client
  1.  ;         0 - Don't reverse
  1.  ;Output:
  1.  ; DWSFLD - Windowman values
  1.  ;
  1.  N INBPN,I,IN0,IN1,INIP
  1.  ;clear out values of Test Parameters
  1.  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)="@"
  1.  ;unsolicited inbound set transaction type or Query response
  1.  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"
  1.  S INVAL=+$G(INVAL)
  1.  ;set background process
  1.  S INBPN=+$$VAL^DWRA(4001.1,INVAL,0,DIE,INDA)
  1.  ;Default read, hang and transmit retries
  1.  D INIT^INHUVUT(INBPN,.INIP)
  1.  ;
  1.  ;Open Hang Open retries
  1.  S DWSFLD(16.03)=INIP("OHNG"),DWSFLD(16.04)=INIP("OTRY")
  1.  ;Transmitter Hang
  1.  S DWSFLD(16.05)=INIP("THNG")
  1.  ;Send Hang, Send retry, Send Timeout
  1.  S DWSFLD(16.06)=INIP("SHNG"),DWSFLD(16.07)=INIP("STRY"),DWSFLD(16.08)=INIP("STO")
  1.  ;Read hand, Read Retry, Read Tiemout
  1.  S DWSFLD(16.09)=INIP("RHNG"),DWSFLD(16.1)=INIP("RTRY"),DWSFLD(16.11)=INIP("RTO")
  1.  S IN0=$G(^INTHPC(INBPN,0)),IN1=$G(^INTHPC(INBPN,1))
  1.  ;Set Client/Server Flag
  1.  S DWSFLD(13.03)=$P(IN0,U,8)
  1.  I INREV,DWSFLD(13.03)'="" S DWSFLD(13.03)='DWSFLD(13.03)
  1.  ;
  1.  ;if remote is client set to server
  1.  I INREV,DWSFLD(13.03)=1 D
  1.  .;Set server port by getting clients IP port
  1.  .S I=0 F  S I=$O(^INTHPC(INBPN,6,I)) Q:'I  D  Q:DWSFLD(16.02)
  1.  ..S J=0 F  S J=$O(^INTHPC(INBPN,6,I,1,J)) Q:'J  D
  1.  ...S DWSFLD(16.02)=$G(^INTHPC(INBPN,6,I,1,J,0))
  1.  ;
  1.  ;If remote is server and current type not Query response
  1.  I INREV,DWSFLD(13.03)=0,$$VAL^DWRA(4001.1,"13.02",0,DIE,INDA)'="Q" D
  1.  .;set client address
  1.  .S DWSFLD(16.01)="127.0.0.1"
  1.  .;set client port
  1.  .S I=$O(^INTHPC(INBPN,5,0))
  1.  .S DWSFLD(16.02)=$G(^INTHPC(INBPN,5,+I,0))
  1.  ;If query response and current BP is a server set to same port
  1.  I $$VAL^DWRA(4001.1,"13.02",0,DIE,INDA)="Q",DWSFLD(13.03)=1 D
  1.  .S I=$O(^INTHPC(INBPN,5,0))
  1.  .S DWSFLD(16.02)=$G(^INTHPC(INBPN,5,+I,0))
  1.  ;End of Line
  1.  S DWSFLD(16.12)=$P(IN1,U,7)
  1.  ;Client Init String
  1.  S DWSFLD(17.01)=$P(IN1,U,8)
  1.  ;Init Response
  1.  S DWSFLD(17.02)=$P(IN1,U,9)
  1.  S (DWSFLD(17.03,0),DWSFLD(18.01,0),DWSFLD(18.02,0))=2
  1.  Q
  1. SCR2(DWSFLD) ;second screen pre check
  1.  ;Input:
  1.  ; DWSFLD - Windowman array
  1.  ;
  1.  I $$VAL^DWRA("4001.1","13.02",1,DIE,INDA)="U" D
  1.  .S (DWSFLD(18.01,0),DWSFLD(18.02,0),DWSFLD(17.03,0))=2
  1.  I $$VAL^DWRA("4001.1","13.02",1,DIE,INDA)="Q" D
  1.  .S (DWSFLD(18.01,0),DWSFLD(18.02,0),DWSFLD(17.03,0))=0
  1.  Q
  1. SCR2APP(DWSFLD,INDA) ;App server second screen
  1.  ;Input:
  1.  ; DWSFLD - Windowman array
  1.  ; INDA -ien of criteria
  1.  ;
  1.  N INBPNAP
  1.  S INBPNAP=+$$VAL^DWRA(4001.1,18.04,0,DIE,INDA)
  1.  I INBPNAP,$$VAL^DWRA(4001.1,17.03,0,DIE,INDA)="" S DWSFLD(17.03)=$P($G(^INTHPC(INBPNAP,7)),U,4)
  1.  ;set local address
  1.  S DWSFLD(18.01)="127.0.0.1"
  1.  ;set port
  1.  S DWSFLD(18.02)="AUTO GENERATE"
  1.  Q
  1. DEFRHT(DWSFLD,INBPN) ;Set Default hang, retry and transmit values
  1.  ;Input:
  1.  ; DWSFLD - Gallery variable
  1.  N INIP
  1.  D INIT^INHUVUT(INBPN,.INIP)
  1.  ;
  1.  ;Open Hang Open retries
  1.  S DWSFLD(16.03)=INIP("OHNG"),DWSFLD(16.04)=INIP("OTRY")
  1.  ;Transmitter Hang
  1.  S DWSFLD(16.05)=INIP("THNG")
  1.  ;Send Hang, Send retry, Send Timeout
  1.  S DWSFLD(16.06)=INIP("SHNG"),DWSFLD(16.07)=INIP("STRY"),DWSFLD(16.08)=INIP("STO")
  1.  ;Read hand, Read Retry, Read Tiemout
  1.  S DWSFLD(16.09)=INIP("RHNG"),DWSFLD(16.1)=INIP("RTRY"),DWSFLD(16.11)=INIP("RTO")
  1.  Q
  1. DISPLAY(MS,INDIS,INUIF) ;Write interactive messages to the screen
  1.  ;INPUT:
  1.  ;  MS - message to display
  1.  ;  INDIS - 0 display to screen, 1 don't display to screen
  1.  ;  INUIF opt - ien of Universal Interface File
  1.  ;OUTPUT:
  1.  ;  INPOP - exit simulator
  1.  N J
  1.  S MS=$G(MS),INDIS=+$G(INDIS),INPOP=+$G(INPOP),INUIF=+$G(INUIF)
  1.  I 'INDIS D
  1.  .U 0 W !,MS
  1.  .I $S(IO'=IO(0):1,1:0) U IO W !,MS
  1.  .S (J,^UTILITY("DIS",$J))=+$G(^UTILITY("DIS",$J))+1
  1.  .S ^UTILITY("DIS",$J,J)=MS
  1.  .I $D(^INTHU(INUIF,0)) D
  1.  ..S ^UTILITY("DIS",$J,J,0)=""
  1.  ..S ^UTILITY("DIS",$J,J,"IEN")=INUIF
  1.  U 0 R *X:0
  1.  I X'=-1 S INPOP=0
  1.  Q:'$G(INIPPO)!'$G(INBPN)
  1.  I 'INPOP D  Q
  1.  .I $S(IO'=IO(0):1,1:0) U IO W !,"Process signalled to terminate",!
  1.  .S MS="Process signalled to terminate"
  1.  .U 0 W !,MS,!
  1.  .S (J,^UTILITY("DIS",$J))=+$G(^UTILITY("DIS",$J))+1
  1.  .S ^UTILITY("DIS",$J,J)=MS
  1.  S ^INRHB("RUN","SRVR",INBPN,INIPPO)=$H_U_MS
  1.  Q
  1. DISONE(IND,IOM) ;display one message
  1.  ; Input:
  1.  ;   IND - Node to parse
  1.  ;   IOM - Margin of display
  1.  N INMS,J,MS,INMSA
  1.  S INMS="INMSA"
  1.  D ONE^INHUT9(IND,.INMS,IOM,3,"|CR|")
  1.  S J=0 F  S J=$O(@INMS@(J)) Q:'J  S MS=@INMS@(J) D:$L(MS) DISPLAY^INTSUT1(MS,INEXPAND)
  1.  I INMS["^" K @INMS
  1.  Q
  1. SCR(IOYF,IOYT,INFR) ;position screen scrolling region
  1.  ;Input:
  1.  ; IOYF - scrolling region start position
  1.  ; IOYT - scrolling region end position
  1.  ; INFR - display frame 
  1.  N DIJC,INA,I
  1.  S INFR=$G(INFR)
  1.  I $G(DIJTT)'="" S INA="GO^DIJS"_DIJTT D @INA
  1.  X DIJC("SCR")
  1.  I INFR W $$SETXY^%ZTF(0,4),DIJC("BXT")
  1.  F I=6:1:18 W $$SETXY^%ZTF(0,I),@DIJC("EOL")
  1.  I INFR W $$SETXY^%ZTF(0,20),DIJC("BXB")
  1.  W $$SETXY^%ZTF(0,6)
  1.  Q
  1. EXPNDIS(INUIF) ;Display expanded message and store
  1.  ;Input:
  1.  ; INUIF - Universal Interface file ien
  1.  N INMS,MS,J,INMSA
  1.  S INMS="INMSA"
  1.  D ONE^INHUT9("^INTHU("_INUIF_",3,0)",.INMS,78,3,"|CR|",1)
  1.  S J=0 F  S J=$O(@INMS@(J)) Q:'J  S MS=@INMS@(J) D:$L(MS) DISPLAY(MS,0,INUIF)
  1.  I INMS["^" K @INMS
  1.  Q
  1. DISPEXP(DWLMK)  ;display expanded list
  1.  ;Input:
  1.  ; DWLMK - Array of Listman selected values
  1.  N DA,DHD,DIC,DIPA,DR,IO,ION,IOST,IOM,IOSL,INIOP,INUIF,INIO,POP,%ZIS,X,Y
  1.  N INT
  1.  I $D(DWLMK)=1,+$G(^UTILITY("DIS",$J,+$P(@DWLMK,U,4),"IEN"))=0 Q
  1.  ;loop and look for a selected message that has a UIF entry quit if none
  1.  S (INUIF,INT)=""
  1.  I $D(DWLMK)'=1 D  Q:'INUIF
  1.  .F  S INT=$O(DWLMK(INT)) Q:INT=""  D  Q:INUIF
  1.  ..S INUIF=+$G(^UTILITY("DIS",$J,INT,"IEN"))
  1.  D CLEAR^DW
  1.  S %ZIS="N" D ^%ZIS Q:POP  S INIO=IO,IOP=ION_";"_IOST_";"_IOM_";"_IOSL
  1.  S INIOP=IOP
  1.  I $D(DWLMK)=1 D  Q
  1.  .S INUIF=+$G(^UTILITY("DIS",$J,+$P(@DWLMK,U,4),"IEN"))
  1.  .Q:'INUIF
  1.  .S DA(INUIF)=""
  1.  .S IOP=INIOP,DIC=4001,DHD="@",DR="INH MESSAGE DISPLAY"
  1.  .D PRTLIST^DWPR
  1.  .S:INIO=IO X=$$CR^UTSRD
  1.  S INT="" F  S INT=$O(DWLMK(INT)) Q:INT=""  D
  1.  .S INUIF=+$G(^UTILITY("DIS",$J,INT,"IEN"))
  1.  .Q:'INUIF
  1.  .S IOP=INIOP
  1.  .S DIC=4001,DHD="@",DR="INH MESSAGE DISPLAY"
  1.  .S DA(INUIF)=""
  1.  .D PRTLIST^DWPR
  1.  S:INIO=IO X=$$CR^UTSRD
  1.  Q