INTSTRT1 ;JD; 26 Mar 97 13:44;
;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
;COPYRIGHT 1991-2000 SAIC
;
Q
QUERY(INDA,DIPA,INEXPAND) ;Do Query response messages
;Input:
; INDA - ien of 4001.1
; DIPA - Store needed variables
; INEXPAND - 0 Don't expand output, 1 expand output
N INBPNSR,INBPNAP,INIPADDR,INIPPO
;get messages from saved message list
D UPDTSND^INTSUT3(INDA)
;Outbound message and nothing was selected to send
I '$D(^UTILITY("INTHU",DUZ,$J)) D DISPLAY^INTSUT1("Note - messages have not been selected transmit")
D ENAUTO^INTS(INDA,.DIPA,INEXPAND)
Q
UNSOLI(INDIR,DIPA,INEXPAND,INDA,DIE) ;Process unsolicted message
;Input:
; INDIR - I Inbound, O Outbound
; DIPA - Store needed variables
; INEXPAND - 0 Don't expand output, 1 expand output
; INDA - ien of 4001.1
; DIE - 4001.1
N INRTN
I INDIR="I" S INRTN="EN^INTSREC(INEXPAND,INDA,DIE)"
I INDIR="O" S INRTN="EN^INTSEND(INEXPAND,INDA,DIE)"
D ZIS^INHUT8(INRTN,"INEXPAND^INDA^DIE^",1,"","",INDEV)
D LISTMSG(INDA)
;If came up as server halt to reset TCP/IP socket
I $$VAL^DWRA(4001.1,13.03,2,"^DIZ(4001.1,",INDA) D HALT
Q
UNIT(INDA,INDIR,INEXPAND) ;Unit test functions
;Input:
; INDA - ien of Criteria
; INDIR - I Inbound, O Outbound
; INEXPAND - 0 Don't expand output, 1 expand output
N INSPROC,INTSK,INHF,INPRE,INPOST
S INSPROC=$$VAL^DWRA(4001.1,13.07,2,DIE,INDA)
S INIP("PRE")=$$VAL^DWRA(4001.1,21.01,2,DIE,INDA)
S INIP("POST")=$$VAL^DWRA(4001.1,22.01,2,DIE,INDA)
S INIP("DIR")=INDIR,INIP("SPROC")=INSPROC
;Start of process=Format does not have UIF messages, others do
;;I INSPROC'="F",'$D(INREQLST) D DISPLAY^INTSUT1("No messages selected") Q
;;Move into INTSTO--I INSPROC'="F",'$D(^UTILITY("INTHU",DUZ,$J)) D DISPLAY^INTSUT1("Note - no messages selected") Q
;;move into INTSTF---I INPRE'="" X INPRE S:$G(INHF) INTSK=INHF
;If start of process=Format, PREprocess code must return INHF>0
;;I INSPROC="F",$G(INHF)<1 D DISPLAY^INTSUT1("No formatter entry exists") Q
;Identify the routine for the entry process
S INROU=$S(INSPROC="F":"EN^INTSTF(.INIP,INEXPAND,INDA)",INSPROC="O":"EN^INTSTO(.INIP,INEXPAND,INDA)",INSPROC="R":"EN^INTSTO(.INIP,INEXPAND,INDA)",1:"Q")
I INROU="Q" D DISPLAY^INTSUT1("No support for this function") Q
D ZIS^INHUT8(INROU,"INTSK^INREQLST(^INIP(",1,"","",INDEV)
D LISTMSG(INDA)
Q
LISTMSG(INDA) ;List Messages using listman
;Input:
; INDA - ien of 4001.1
; ^UTILITY("DIS",$J) - Global with messages in it
;
N DWL,DWLRF,DWLB
S DWLB="0^4^16^78"
S DWL("TITLE")="D LSTHDR^INTSTRT("_INDA_")"
S DWLRF="^UTILITY(""DIS"",$J)",DWL="XWFE'",DWLB="0^4^16^78"
F D ^DWL Q:DWLR'="E" D DISPEXP^INTSUT1(.DWLRF),LSTHDR^INTSTRT(INDA)
;D:$D(DWLMK)>1 DISPEXP^INTSUT1(.DWLMK),CLR^DIJF,SCR^INTSUT1(5,17,1),LSTHDR^INTSTRT(INDA)
K ^UTILITY("DIS",$J)
Q
CRDUZ ;Stuff current user DUZ into file
N INOIEN
S INOIEN=$O(^UTILITY("INHSYS",$J,4001.1,""))
I INOIEN D
.;set user field to current user
.S $P(^UTILITY("INHSYS",$J,4001.1,INOIEN,0),U,2)=$P(^DIC(3,DUZ,0),U)
Q
CONTINUE(INODE0) ;Continue with restore or stop
;Input:
; INODE0 - 0 node of flat file or 4001.1 file
Q:'$$EXISTS^INTSUT3(INODE0,.INAME) 1
Q $$YN^UTWRD("Overwrite "_INAME_" with new version? ;0")
;
HALT ;Halt if process was a server
;D CLR^DIJF
;W !,"Process was a Server. Halting to close socket"
;D HALT^ZU
Q
UNLOCK(INDA,INOPT) ;unlock all but one lock of INDA
;Input:
; INDA - ien of lock to keep locked
; INOPT - array with lock count
;
N INA,%
S INA="" F S INA=$O(INOPT("LOCK",INA)) Q:'INA D
.;unlock all non INDA locks
.I INA'=INDA D
..F I=+INOPT("LOCK",INA):-1:1 S %=$$LOCK^INHUTC(INA,0)
..K INOPT("LOCK",INA)
.;if same as INDA unlock all but one lock
.I INA=INDA D
..F I=+INOPT("LOCK",INA):-1:2 S %=$$LOCK^INHUTC(INA,0)
..S INOPT("LOCK",INA)=1
Q
INTSTRT1 ;JD; 26 Mar 97 13:44;
+1 ;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
+2 ;COPYRIGHT 1991-2000 SAIC
+3 ;
+4 QUIT
QUERY(INDA,DIPA,INEXPAND) ;Do Query response messages
+1 ;Input:
+2 ; INDA - ien of 4001.1
+3 ; DIPA - Store needed variables
+4 ; INEXPAND - 0 Don't expand output, 1 expand output
+5 NEW INBPNSR,INBPNAP,INIPADDR,INIPPO
+6 ;get messages from saved message list
+7 DO UPDTSND^INTSUT3(INDA)
+8 ;Outbound message and nothing was selected to send
+9 IF '$DATA(^UTILITY("INTHU",DUZ,$JOB))
DO DISPLAY^INTSUT1("Note - messages have not been selected transmit")
+10 DO ENAUTO^INTS(INDA,.DIPA,INEXPAND)
+11 QUIT
UNSOLI(INDIR,DIPA,INEXPAND,INDA,DIE) ;Process unsolicted message
+1 ;Input:
+2 ; INDIR - I Inbound, O Outbound
+3 ; DIPA - Store needed variables
+4 ; INEXPAND - 0 Don't expand output, 1 expand output
+5 ; INDA - ien of 4001.1
+6 ; DIE - 4001.1
+7 NEW INRTN
+8 IF INDIR="I"
SET INRTN="EN^INTSREC(INEXPAND,INDA,DIE)"
+9 IF INDIR="O"
SET INRTN="EN^INTSEND(INEXPAND,INDA,DIE)"
+10 DO ZIS^INHUT8(INRTN,"INEXPAND^INDA^DIE^",1,"","",INDEV)
+11 DO LISTMSG(INDA)
+12 ;If came up as server halt to reset TCP/IP socket
+13 IF $$VAL^DWRA(4001.1,13.03,2,"^DIZ(4001.1,",INDA)
DO HALT
+14 QUIT
UNIT(INDA,INDIR,INEXPAND) ;Unit test functions
+1 ;Input:
+2 ; INDA - ien of Criteria
+3 ; INDIR - I Inbound, O Outbound
+4 ; INEXPAND - 0 Don't expand output, 1 expand output
+5 NEW INSPROC,INTSK,INHF,INPRE,INPOST
+6 SET INSPROC=$$VAL^DWRA(4001.1,13.07,2,DIE,INDA)
+7 SET INIP("PRE")=$$VAL^DWRA(4001.1,21.01,2,DIE,INDA)
+8 SET INIP("POST")=$$VAL^DWRA(4001.1,22.01,2,DIE,INDA)
+9 SET INIP("DIR")=INDIR
SET INIP("SPROC")=INSPROC
+10 ;Start of process=Format does not have UIF messages, others do
+11 ;;I INSPROC'="F",'$D(INREQLST) D DISPLAY^INTSUT1("No messages selected") Q
+12 ;;Move into INTSTO--I INSPROC'="F",'$D(^UTILITY("INTHU",DUZ,$J)) D DISPLAY^INTSUT1("Note - no messages selected") Q
+13 ;;move into INTSTF---I INPRE'="" X INPRE S:$G(INHF) INTSK=INHF
+14 ;If start of process=Format, PREprocess code must return INHF>0
+15 ;;I INSPROC="F",$G(INHF)<1 D DISPLAY^INTSUT1("No formatter entry exists") Q
+16 ;Identify the routine for the entry process
+17 SET INROU=$SELECT(INSPROC="F":"EN^INTSTF(.INIP,INEXPAND,INDA)",INSPROC="O":"EN^INTSTO(.INIP,INEXPAND,INDA)",INSPROC="R":"EN^INTSTO(.INIP,INEXPAND,INDA)",1:"Q")
+18 IF INROU="Q"
DO DISPLAY^INTSUT1("No support for this function")
QUIT
+19 DO ZIS^INHUT8(INROU,"INTSK^INREQLST(^INIP(",1,"","",INDEV)
+20 DO LISTMSG(INDA)
+21 QUIT
LISTMSG(INDA) ;List Messages using listman
+1 ;Input:
+2 ; INDA - ien of 4001.1
+3 ; ^UTILITY("DIS",$J) - Global with messages in it
+4 ;
+5 NEW DWL,DWLRF,DWLB
+6 SET DWLB="0^4^16^78"
+7 SET DWL("TITLE")="D LSTHDR^INTSTRT("_INDA_")"
+8 SET DWLRF="^UTILITY(""DIS"",$J)"
SET DWL="XWFE'"
SET DWLB="0^4^16^78"
+9 FOR
DO ^DWL
IF DWLR'="E"
QUIT
DO DISPEXP^INTSUT1(.DWLRF)
DO LSTHDR^INTSTRT(INDA)
+10 ;D:$D(DWLMK)>1 DISPEXP^INTSUT1(.DWLMK),CLR^DIJF,SCR^INTSUT1(5,17,1),LSTHDR^INTSTRT(INDA)
+11 KILL ^UTILITY("DIS",$JOB)
+12 QUIT
CRDUZ ;Stuff current user DUZ into file
+1 NEW INOIEN
+2 SET INOIEN=$ORDER(^UTILITY("INHSYS",$JOB,4001.1,""))
+3 IF INOIEN
Begin DoDot:1
+4 ;set user field to current user
+5 SET $PIECE(^UTILITY("INHSYS",$JOB,4001.1,INOIEN,0),U,2)=$PIECE(^DIC(3,DUZ,0),U)
End DoDot:1
+6 QUIT
CONTINUE(INODE0) ;Continue with restore or stop
+1 ;Input:
+2 ; INODE0 - 0 node of flat file or 4001.1 file
+3 IF '$$EXISTS^INTSUT3(INODE0,.INAME)
QUIT 1
+4 QUIT $$YN^UTWRD("Overwrite "_INAME_" with new version? ;0")
+5 ;
HALT ;Halt if process was a server
+1 ;D CLR^DIJF
+2 ;W !,"Process was a Server. Halting to close socket"
+3 ;D HALT^ZU
+4 QUIT
UNLOCK(INDA,INOPT) ;unlock all but one lock of INDA
+1 ;Input:
+2 ; INDA - ien of lock to keep locked
+3 ; INOPT - array with lock count
+4 ;
+5 NEW INA,%
+6 SET INA=""
FOR
SET INA=$ORDER(INOPT("LOCK",INA))
IF 'INA
QUIT
Begin DoDot:1
+7 ;unlock all non INDA locks
+8 IF INA'=INDA
Begin DoDot:2
+9 FOR I=+INOPT("LOCK",INA):-1:1
SET %=$$LOCK^INHUTC(INA,0)
+10 KILL INOPT("LOCK",INA)
End DoDot:2
+11 ;if same as INDA unlock all but one lock
+12 IF INA=INDA
Begin DoDot:2
+13 FOR I=+INOPT("LOCK",INA):-1:2
SET %=$$LOCK^INHUTC(INA,0)
+14 SET INOPT("LOCK",INA)=1
End DoDot:2
End DoDot:1
+15 QUIT
