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

INTSUT2.m

Go to the documentation of this file. 
  1. INTSUT2 ;JPD; 1 Feb 96 09:26; Utility routine 
  1.  ;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
  1.  ;COPYRIGHT 1991-2000 SAIC
  1.  ;
  1.  Q
  1. CHECK(INDA,DIE,Y,DWSFLD) ;called from post action of 1st screen of
  1.  ;windowman gallery.
  1.  ;Input:
  1.  ; INDA - ien of 4001.1 entry
  1.  ; DIE - ^DIZ(4001.1,
  1.  ;Output:
  1.  ; Y - where to put cursor
  1.  ; DWSFLD - Array of values for gallery
  1.  ;
  1.  N INIPPO,INBPN,INBPNAP
  1.  ;Type is Unit test
  1.  I $$VAL^DWRA(4001.1,13.02,0,DIE,INDA)="T" S Y="" Q 1
  1.  ;If logon server and no app server have them get app server
  1.  I $$VAL^DWRA(4001.1,18.03,0,DIE,INDA),'$$VAL^DWRA(4001.1,18.04,0,DIE,INDA) D  Q 0
  1.  .D MSG("You picked a Logon Server but no App Server")
  1.  .S Y="18.04"
  1.  ;If App server and no logon server have them get logon server
  1.  I $$VAL^DWRA(4001.1,18.04,0,DIE,INDA),'$$VAL^DWRA(4001.1,18.03,0,DIE,INDA) D  Q 0
  1.  .D MSG("You picked an App Server but no Logon Server")
  1.  .S Y="18.03"
  1.  I $$VAL^DWRA(4001.1,13.02,0,DIE,INDA)="U",$$VAL^DWRA(4001.1,6,0,DIE,INDA)="" D  Q 0
  1.  .D MSG("You must pick a direction. Inbound or Outbound")
  1.  .S Y=6
  1.  Q 1
  1. GETPORT(INBPN) ;get port - called from INTS
  1.  ;Input:
  1.  ; INBPN - ien of background process
  1.  N INIPPO,POP
  1.  S POP=0,INIPPO=6100 F  S INIPPO=INIPPO+$R(15)+10 D  Q:POP
  1.  .L +^INRHB("RUN","SRVR",INBPN,INIPPO):0 S:$T POP=1
  1.  .S ^INRHB("RUN","SRVR",INBPN,INIPPO)=$H
  1.  Q INIPPO
  1. PORTULCK(INIPPO) ;current port value changed- called from gallery
  1.  ;Input:
  1.  ; INIPPO - port number
  1.  N INBPN
  1.  S INBPN=+$O(^INTHPC("B","TEST INTERACTIVE",""))
  1.  L -^INRHB("RUN","SRVR",INBPN,INIPPO)
  1.  Q
  1. LOCKPORT(X) ;Lock port - called from gallery
  1.  ;Input:
  1.  ; X - Port number
  1.  N INBPN
  1.  S INBPN=+$O(^INTHPC("B","TEST INTERACTIVE",""))
  1.  L +^INRHB("RUN","SRVR",INBPN,X):0 I '$T D  Q
  1.  .D MSG("Port is already locked by another user. Pick another one")
  1.  .K X
  1.  S DIPA("18.02")=X
  1.  S ^INRHB("RUN","SRVR",INBPN,X)=$H
  1.  Q
  1. TYPECHK(INDA,X,DWDIPA,DWSFLD) ;User sets TYPE field.
  1.  ;Input:
  1.  ; INDA - ien of Criteria
  1.  ; X - Value inserted by user in TYPE field
  1.  ;Output:
  1.  ; DWDIPA - sets DIPA
  1.  ; DWSFLD - Sets value in fields
  1.  ;
  1.  N INBPN,INIPPO,INBPNAP
  1.  ;called from post action of field 13.02 in windowman gallery
  1.  S DWDIPA(13.02,13.02)=""
  1.  ;If type is changing blank out second screen values
  1.  I $D(DWFCHG) F I=13.03,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,17.03,18.01,18.02 S DWSFLD(I)="@"
  1.  ;
  1.  ;If type is unsolicited clear query values make uneditable
  1.  I $E(X)="U" D
  1.  .;make fields display only
  1.  .S (DWSFLD(17.03,0),DWSFLD(18.01,0),DWSFLD(18.02,0),DWSFLD(18.03,0),DWSFLD(18.04,0),DWSFLD(13.07,0))=2
  1.  .;clear fields
  1.  .S DWSFLD(18.03)="^S X=""@""",DWSFLD(18.04)="^S X=""@""",DWSFLD(13.07)="^S X=""@""",DWSFLD(17.03)="^S X=""@""",DWSFLD(18.01)="^S X=""@""",DWSFLD(18.02)="^S X=""@"""
  1.  .;make fields editable
  1.  .S (DWSFLD(20,0),DWSFLD(6,0))=0
  1.  .S INBPN=+$$VAL^DWRA(4001.1,20,1,DIE,INDA)
  1.  .;Inbound unsolicited set accept ack transaction type
  1.  .I $$VAL^DWRA(4001.1,6,1,DIE,INDA)="I" S DWSFLD(13.01)="HL GIS ACCEPT ACKNOWLEDGEMENT"
  1.  .S (DWSFLD(17.03,0),DWSFLD(18.01,0),DWSFLD(18.02,0))=2
  1.  .;only continue if change was made to reinitialize
  1.  .Q:'$D(DWFCHG)
  1.  .;if inbound then set Accept ack Tran type
  1.  .I $$VAL^DWRA(4001.1,6,0,DIE,INDA)="I" S DWSFLD(13.01)="HL GIS ACCEPT ACKNOWLEDGEMENT"
  1.  .S DWSFLD(13.04)="AL"
  1.  .D DEFRHT^INTSUT1(.DWSFLD,+$G(INBPN))
  1.  ;If query response
  1.  I $E(X)="Q" D
  1.  .;make background process/Start at process display only and clear them
  1.  .S (DWSFLD(20,0),DWSFLD(13.07,0))="2^1"
  1.  .S DWSFLD(20)="^S X=""@""",DWSFLD(13.07)="^S X=""@"""
  1.  .S DWSFLD(6)="O",DWSFLD(6,0)=2
  1.  .S (DWSFLD(18.03,0),DWSFLD(18.04,0))=0
  1.  .;only continue if change was made to reinitialize
  1.  .Q:'$D(DWFCHG)
  1.  .;Accept Transaction Type
  1.  .S DWSFLD(13.01)="HL GIS ACCEPT ACKNOWLEDGEMENT"
  1.  .;Accept ack condition
  1.  .S DWSFLD(13.04)="AL"
  1.  .;Query response background process
  1.  .S INBPN=+$O(^INTHPC("B","TEST INTERACTIVE",""))
  1.  .I $$VAL^DWRA(4001.1,18.01,0,DIE,INDA)="" S DWSFLD(18.01)="127.0.0.1"
  1.  .;set port
  1.  .S INIPPO=$$VAL^DWRA(4001.1,18.02,0,DIE,INDA)
  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.  .D DEFRHT^INTSUT1(.DWSFLD,+$G(INBPN))
  1.  .;if port not set
  1.  .I INIPPO="" S DWSFLD(18.02)="AUTO GENERATE"
  1.  .E  I INIPPO'="",$E(INIPPO,1,4)'="AUTO" D
  1.  ..;try locking existing defined port
  1.  ..L +^INRHB("RUN","SRVR",INBPN,INIPPO):0 I '$T D MSG("Note - Port currently locked by another user")
  1.  ..L -^INRHB("RUN","SRVR",INBPN,INIPPO)
  1.  ;Unit test
  1.  I $E(X)="T" D
  1.  .S (DWSFLD(18.03,0),DWSFLD(18.04,0))=2
  1.  .;clear fields
  1.  .S (DWSFLD(18.03),DWSFLD(18.04),DWSFLD(6))="^S X=""@"""
  1.  .S DWSFLD(20,0)="2^1",DWSFLD(20)="^S X=""@"""
  1.  .;start at process required and direction uneditable
  1.  .S DWSFLD(13.07,0)=1,DWSFLD(6,0)=2
  1.  Q
  1. CLSVCK(X,DWSFLD) ;client server check
  1.  ;Input:
  1.  ; X - User input - 0 Client, 1 Server
  1.  ;Output:
  1.  ; DWSFLD - Array to set gallery
  1.  ;
  1.  ;answer was server
  1.  I X=1 S DWSFLD(16.01,0)=2,DWSFLD(16.01)="^S X=""@"""
  1.  ;answer was client or not answered
  1.  I 'X S DWSFLD(16.01,0)=0
  1.  Q
  1. MSG(MSG) ;Write message to screen
  1.  ;Input:
  1.  ; MSG - message to display
  1.  W $$SETXY^%ZTF(0,21),MSG,*7
  1.  Q
  1. PRE(INDA,INPRE,INUIF,INARY) ;Pre process
  1.  ;Input:
  1.  ; INDA - ien of 4001.1
  1.  ; INPRE - xecutable pre processing code
  1.  ; INUIF - Current Universal Interface file ien to be sent next
  1.  ;Output: INARY("C") = ien  -  Current UIF ien value to process
  1.  ;        INARY("A",n) =  ien  - Process UIF at position n in ^UTILITY
  1.  ;        INARY("F") = ien - First UIF entry to process
  1.  ;        INARY("L") = ien - Last UIF entry to process  
  1.  ;        INARY("M",n) = Message to display & save in displayman array
  1.  ;        INARY("REF") = 1 Refresh command screen when done
  1.  N DIPA,INBPN,INIP,INCHNL,INIP,INDEST,INXDST,INTT
  1.  K INARY
  1.  D DISPLAY^INTSUT1("Pre Processing")
  1.  X INPRE
  1.  Q
  1. POSTPRE(INDA,INARY,INEXTUIF,INLASTN,INPOP,INUPDAT) ;Post Pre processing
  1.  ; Input: 
  1.  ;  INARY= "^INTHU" , "^INLHFTSK"
  1.  ;  INARY("C") = ien  -  Current UIF ien value to process
  1.  ;  INARY("A",n) =  ien  - Process UIF at position n in ^UTILITY
  1.  ;  INARY("F") = ien - First UIF entry to process
  1.  ;  INARY("L") = ien - Last UIF entry to process  
  1.  ;  INARY("M",n) = Message to display & save in displayman array
  1.  ;  INARY("REF") = 1 Refresh command screen when done
  1.  ; Output: INEXTUIF - Next Universal Interface file entry to process -
  1.  ;                    can be set/reset by the programmer
  1.  ;         INLASTN - Last entry in ^UTILITY global processed - can be
  1.  ;                   set/reset by the programmer - (should be set if
  1.  ;                   it was not set previously)
  1.  ; INEXTUIF and INLASTN need to be set in or out of the PRE and POST
  1.  ; in order to process at least one message.
  1.  ;
  1.  N INP
  1.  I 'INPOP Q 0
  1.  Q:$D(INARY)<10 1
  1.  K INUPDAT
  1.  I $G(INARY("C"))+$G(INARY("F"))+$G(INARY("L"))+$O(INARY("A","")) S INUPDAT=1
  1.  I $G(INARY("REF")) D
  1.  .;D CLR^DIJF
  1.  .D LSTHDR^INTSTRT(INDA)
  1.  .D SCR^INTSUT1(5,17,1)
  1.  S:$G(INARY)="" INARY="^INTHU"
  1.  D DISPLAY^INTSUT1("POSTPRE Processing")
  1.  ;current entry to process
  1.  I +$G(INARY("C")) S INEXTUIF=+INARY("C")
  1.  D MERGE2^INTSUT3(.INARY)
  1.  ;put entry in first spot
  1.  I $D(@(INARY_"(+$G(INARY(""F"")),0)")) D
  1.  .S INP=+$O(^UTILITY("INTHU",DUZ,$J,""))
  1.  .I INP S INP=INP-".00001"
  1.  .S:'INP INP=1
  1.  .S ^UTILITY("INTHU",DUZ,$J,INP,INARY("F"))=INARY("F")
  1.  ;Put entry in last spot 
  1.  I $D(@(INARY_"(+$G(INARY(""L"")),0)")) D
  1.  .S INP=+$O(^UTILITY("INTHU",DUZ,$J,""),-1)
  1.  .S ^UTILITY("INTHU",DUZ,$J,INP,INARY("L"))=INARY("L")
  1.  I '$L($G(INLASTN)),$D(INUPDAT) D
  1.  .S INLASTN=$O(^UTILITY("INTHU",DUZ,$J,""))
  1.  .I '$L($G(INEXTUIF)) S INEXTUIF=$O(^UTILITY("INTHU",DUZ,$J,+INLASTN,""))
  1.  ;put messages in displayman array
  1.  S INP=""
  1.  F  S INP=$O(INARY("M",INP)) Q:'INP  D DISPLAY^INTSUT1(INARY("M",INP),INEXPAND)
  1.  K INARY
  1.  ;Update Multiple
  1.  D UPDTFRUT^INTSUT3(INDA)
  1.  Q 1
  1. POST(INDA,INEXTUIF,INARY) ;Post process
  1.  ;Input:
  1.  ; INDA - ien of 4001.1
  1.  ; INEXTUIF - next UIF ien to transmit
  1.  ; Input: INARY("C") = ien  -  Current UIF ien value to process
  1.  ;        INARY("A",n) =  ien  - Process UIF at position n in ^UTILITY
  1.  ;        INARY("F") = ien - First UIF entry to process
  1.  ;        INARY("L") = ien - Last UIF entry to process  
  1.  ;        INARY("M",n) = "Message to display & save in displayman array
  1.  ;        INARY("REF") = 1 Refresh command screen when done
  1.  N DIPA,DIE,INBPN,INIP,INCHNL,INIP,INDEST,INXDST,INTT
  1.  S INEXTUIF=$G(INEXTUIF)
  1.  D DISPLAY^INTSUT1("Post Processing")
  1.  X INIP("POST")
  1.  Q