INHUTC6 ;KN,bar; 13 Aug 97 09:18; Interface Message/Error Search
;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
;COPYRIGHT 1991-2000 SAIC
;
; MODULE NAME: Interface Message/Error Search Part III (INHUTC6)
;
; PURPOSE:
; The purpose of this Message/Error Search module is to provide User/
; Programmer a generic search functionality into file ^INTHU and
; ^INTHER . This module contains three subs modules: INHUTC4, INHUTC5
; and INHUTC6.
;
; DESCRIPTION:
; This sub-module contains function GATHER and BLDLIST
;
GATHER(INDA,INSRCH) ; Collect search criteria data
;
; input: INDA = entry number in INTERFACE CRITERIA file
; INSRCH = array of search criteria, passed by reference
; return: INDA if successful
; Error text if unsuccesful
;
; Description: Collects data from the INTERFACE CRITERIA file based
; on the type of search defined and creates the INSRCH array.
; Also calculates the start date and end date based on
; relative (start/end) date and/or absolute (start/end) date.
;
; Code begins:
N X,Y,INX,INY,INNODE,INEND,INSTART,INTYPE,INETBL,INMTBL
Q:'$G(INDA) "GATHER: Criteria ien not present."
Q:'$D(^DIZ(4001.1,INDA,0)) "GATHER: Criteria entry not found."
; Set the constant values for Transaction or Error
S INTYPE=$P(^DIZ(4001.1,INDA,0),U,5)
Q:'$$TYPE^INHUTC2(INTYPE,1) "GATHER: Invalid criteria type for search."
; update relative dates before we retrieve values
D RELDATE^INHUTC2(INDA)
;
;---------- SINGLE VALUE ENTRIES -------------------------------
S INSRCH("TYPE")=INTYPE
S INY=0 F INX="INSTART","INDEST","INSTAT","INID","INSOURCE","INDIR","INORIG","INPAT","INTEMP","INTYPE","INORDER","INEXPAND" S INY=INY+1,X=$G(^DIZ(4001.1,INDA,INY)) S:$L(X) INSRCH(INX)=X
S INSRCH("INEND")=$G(^DIZ(4001.1,INDA,1.1))
; Only set the value for USER and DIVISION if they exist
S X=$G(^DIZ(4001.1,INDA,24))
S:$P(X,U,3) INSRCH("INDIV")=$P(X,U,3)
S:$P(X,U,4) INSRCH("INUSER")=$P(X,U,4)
;
;---------- MULTIPLE VALUE ENTRIES ------------------------------
; Get the multiple in node 31, 32, 33 and 34 indicated by INNODE
S INNODE=30 F INX="MULTIORIG","MULTIDEST","MULTISTAT","MULTIDIV" D
. S INNODE=INNODE+1,INY=0
. F S INY=$O(^DIZ(4001.1,INDA,INNODE,INY)) Q:'INY S X=$G(^(INY,0)) S:$L(X) INSRCH(INX,X)=""
; text search field
I $D(^DIZ(4001.1,INDA,9,0)) S INY=0 F S INY=$O(^DIZ(4001.1,INDA,9,INY)) Q:'INY S INSRCH("INTEXT")=INY,INSRCH("INTEXT",INY)=$G(^(INY,0))
; set the search string match type (AND/OR)
S:($D(INSRCH("INTEXT"))>9)&('$D(INSRCH("INTYPE"))) INSRCH("INTYPE")=0
;
;---------- TRANSACTION SPECIFIC --------------------------------
I INTYPE="TRANSACTION" S INSRCH("FILENAME")="^INTHU",INSRCH("FILENUM")=4001,INSRCH("MSG")="MESSAGE"
;
;---------- ERROR SPECIFIC --------------------------------------
I INTYPE="ERROR" D
. S INSRCH("FILENAME")="^INTHER",INSRCH("FILENUM")=4003,INSRCH("MSG")="ERROR"
. ; Loop through node 15 and get all value for error criteria
. S INX=$G(^DIZ(4001.1,INDA,15)),INY=0
. F X="INMSGSTART","INMSGEND","INERLOC","INERSTAT" S INY=INY+1,Y=$P(INX,U,INY) S:$L(Y) INSRCH(X)=Y
. ; build table values for later use in display
. D CODETBL^INHERR3("INETBL",4003,.1),CODETBL^INHERR3("INMTBL",4001,.03)
. M INSRCH("INETBL")=INETBL,INSRCH("INMTBL")=INMTBL
;
;---------- DATE MANIPULATION -----------------------------------
; obtain Date information
S INSTART=$G(INSRCH("INSTART")),INEND=$G(INSRCH("INEND"))
D GETDATE^INHERR4(.INSTART,.INEND)
S INSRCH("INSTART")=INSTART,INSRCH("INEND")=INEND
; Get the auxiliary date for error
I INTYPE="ERROR",$D(INSRCH("INMSGSTART"))!$D(INSRCH("INMSGEND")) D
. S INSTART=$G(INSRCH("INMSGSTART")),INEND=$G(INSRCH("INMSGEND"))
. D GETDATE^INHERR4(.INSTART,.INEND)
. S INSRCH("INMSGSTART")=INSTART,INSRCH("INMSGEND")=INEND
; Set Indicator for search starting point and direction
S:'$G(INSRCH("INORDER")) (INSRCH("INORDER"),^DIZ(4001.1,INDA,11))=0
S INSRCH("IND")=$S('INSRCH("INORDER"):INSRCH("INEND"),1:INSRCH("INSTART"))
; set flag for transaction search under error search
F X="INMSGSTART","INMSGEND","INID","INDIR","INPAT","INSOURCE" I $D(INSRCH(X)) S INSRCH("MESSAGEREQ")=1 Q
; system settings, min is 20000
S INX=$P($G(^INRHSITE(1,0)),U,14),INSRCH("SPACE")=$S(INX>20000:INX,1:20000)
Q INDA
;
LOCK(INGLB,INDA,INMODE,INTIME,INOPT,INCLR) ; lock file entry
;
; Description: Lock and Unlock entries in a global and track
; incremental locks
;
; Return:
; TRUE = success
; FAILSE = faild
; Parameters:
; INGLB = file number or global base ref ie; "^DIC(3,"
; INDA = entry in criteria file to lock (req)
; INMODE = 1 to lock and 0 to unlock 0 is default
; INTIME = timeout value, defaults to DTIME or 5 sec if
; DTIME is not around.
; INOPT = INOPT("LOCK", is where the lock array in kept
; INOPT("LOCK",INGLB,INDA)=num_of_locks
; INCLR = optional. 0 or not used will do nothing extra
; if 1, will clear all locks in INOPT("LOCK",INGLB)
; if 2, will clear all locks in INOPT("LOCK")
;
; check for req values, set defaults
Q:'$L($G(INGLB)) 0 Q:'$G(INDA) 0 S:'$D(INTIME) INTIME=$G(DTIME,5) S INMODE=+$G(INMODE)
; if numeric, get global base ref from FM
I INGLB=+INGLB S INGLB=$G(^DIC(INGLB,0,"GL")) Q:'$L($G(INGLB)) 0
; if clearing locks do recursive unlock and quit
I $G(INCLR) D Q
. N ING,INY,INN
. ; loop thru globals
. S ING=0 F S ING=$O(INOPT("LOCK",ING)) Q:'$L(ING) D
.. ; loop thru iens
.. S INY=0 F S INY=$O(INOPT("LOCK",ING,INY)) Q:'INY D
... ; loop thru num_of_locks
... S INN=INOPT("LOCK",ING,INY) F S INN=INN-$$LOCK(ING,INY,0)
N INODE,INT S INODE=INGLB_INDA_")"
; lock entry
I INMODE S INT=0 D Q INT
. L +@INODE:INTIME E Q
. S INT=1,INOPT("LOCK",INGLB,INDA)=$G(INOPT("LOCK",INGLB,INDA))+1
; unlock entry
L -@INODE S INOPT("LOCK",INGLB,INDA)=$G(INOPT("LOCK",INGLB,INDA))-1
Q 1
;
INHUTC6 ;KN,bar; 13 Aug 97 09:18; Interface Message/Error Search
+1 ;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
+2 ;COPYRIGHT 1991-2000 SAIC
+3 ;
+4 ; MODULE NAME: Interface Message/Error Search Part III (INHUTC6)
+5 ;
+6 ; PURPOSE:
+7 ; The purpose of this Message/Error Search module is to provide User/
+8 ; Programmer a generic search functionality into file ^INTHU and
+9 ; ^INTHER . This module contains three subs modules: INHUTC4, INHUTC5
+10 ; and INHUTC6.
+11 ;
+12 ; DESCRIPTION:
+13 ; This sub-module contains function GATHER and BLDLIST
+14 ;
GATHER(INDA,INSRCH) ; Collect search criteria data
+1 ;
+2 ; input: INDA = entry number in INTERFACE CRITERIA file
+3 ; INSRCH = array of search criteria, passed by reference
+4 ; return: INDA if successful
+5 ; Error text if unsuccesful
+6 ;
+7 ; Description: Collects data from the INTERFACE CRITERIA file based
+8 ; on the type of search defined and creates the INSRCH array.
+9 ; Also calculates the start date and end date based on
+10 ; relative (start/end) date and/or absolute (start/end) date.
+11 ;
+12 ; Code begins:
+13 NEW X,Y,INX,INY,INNODE,INEND,INSTART,INTYPE,INETBL,INMTBL
+14 IF '$GET(INDA)
QUIT "GATHER: Criteria ien not present."
+15 IF '$DATA(^DIZ(4001.1,INDA,0))
QUIT "GATHER: Criteria entry not found."
+16 ; Set the constant values for Transaction or Error
+17 SET INTYPE=$PIECE(^DIZ(4001.1,INDA,0),U,5)
+18 IF '$$TYPE^INHUTC2(INTYPE,1)
QUIT "GATHER: Invalid criteria type for search."
+19 ; update relative dates before we retrieve values
+20 DO RELDATE^INHUTC2(INDA)
+21 ;
+22 ;---------- SINGLE VALUE ENTRIES -------------------------------
+23 SET INSRCH("TYPE")=INTYPE
+24 SET INY=0
FOR INX="INSTART","INDEST","INSTAT","INID","INSOURCE","INDIR","INORIG","INPAT","INTEMP","INTYPE","INORDER","INEXPAND"
SET INY=INY+1
SET X=$GET(^DIZ(4001.1,INDA,INY))
IF $LENGTH(X)
SET INSRCH(INX)=X
+25 SET INSRCH("INEND")=$GET(^DIZ(4001.1,INDA,1.1))
+26 ; Only set the value for USER and DIVISION if they exist
+27 SET X=$GET(^DIZ(4001.1,INDA,24))
+28 IF $PIECE(X,U,3)
SET INSRCH("INDIV")=$PIECE(X,U,3)
+29 IF $PIECE(X,U,4)
SET INSRCH("INUSER")=$PIECE(X,U,4)
+30 ;
+31 ;---------- MULTIPLE VALUE ENTRIES ------------------------------
+32 ; Get the multiple in node 31, 32, 33 and 34 indicated by INNODE
+33 SET INNODE=30
FOR INX="MULTIORIG","MULTIDEST","MULTISTAT","MULTIDIV"
Begin DoDot:1
+34 SET INNODE=INNODE+1
SET INY=0
+35 FOR
SET INY=$ORDER(^DIZ(4001.1,INDA,INNODE,INY))
IF 'INY
QUIT
SET X=$GET(^(INY,0))
IF $LENGTH(X)
SET INSRCH(INX,X)=""
End DoDot:1
+36 ; text search field
+37 IF $DATA(^DIZ(4001.1,INDA,9,0))
SET INY=0
FOR
SET INY=$ORDER(^DIZ(4001.1,INDA,9,INY))
IF 'INY
QUIT
SET INSRCH("INTEXT")=INY
SET INSRCH("INTEXT",INY)=$GET(^(INY,0))
+38 ; set the search string match type (AND/OR)
+39 IF ($DATA(INSRCH("INTEXT"))>9)&('$DATA(INSRCH("INTYPE")))
SET INSRCH("INTYPE")=0
+40 ;
+41 ;---------- TRANSACTION SPECIFIC --------------------------------
+42 IF INTYPE="TRANSACTION"
SET INSRCH("FILENAME")="^INTHU"
SET INSRCH("FILENUM")=4001
SET INSRCH("MSG")="MESSAGE"
+43 ;
+44 ;---------- ERROR SPECIFIC --------------------------------------
+45 IF INTYPE="ERROR"
Begin DoDot:1
+46 SET INSRCH("FILENAME")="^INTHER"
SET INSRCH("FILENUM")=4003
SET INSRCH("MSG")="ERROR"
+47 ; Loop through node 15 and get all value for error criteria
+48 SET INX=$GET(^DIZ(4001.1,INDA,15))
SET INY=0
+49 FOR X="INMSGSTART","INMSGEND","INERLOC","INERSTAT"
SET INY=INY+1
SET Y=$PIECE(INX,U,INY)
IF $LENGTH(Y)
SET INSRCH(X)=Y
+50 ; build table values for later use in display
+51 DO CODETBL^INHERR3("INETBL",4003,.1)
DO CODETBL^INHERR3("INMTBL",4001,.03)
+52 MERGE INSRCH("INETBL")=INETBL,INSRCH("INMTBL")=INMTBL
End DoDot:1
+53 ;
+54 ;---------- DATE MANIPULATION -----------------------------------
+55 ; obtain Date information
+56 SET INSTART=$GET(INSRCH("INSTART"))
SET INEND=$GET(INSRCH("INEND"))
+57 DO GETDATE^INHERR4(.INSTART,.INEND)
+58 SET INSRCH("INSTART")=INSTART
SET INSRCH("INEND")=INEND
+59 ; Get the auxiliary date for error
+60 IF INTYPE="ERROR"
IF $DATA(INSRCH("INMSGSTART"))!$DATA(INSRCH("INMSGEND"))
Begin DoDot:1
+61 SET INSTART=$GET(INSRCH("INMSGSTART"))
SET INEND=$GET(INSRCH("INMSGEND"))
+62 DO GETDATE^INHERR4(.INSTART,.INEND)
+63 SET INSRCH("INMSGSTART")=INSTART
SET INSRCH("INMSGEND")=INEND
End DoDot:1
+64 ; Set Indicator for search starting point and direction
+65 IF '$GET(INSRCH("INORDER"))
SET (INSRCH("INORDER"),^DIZ(4001.1,INDA,11))=0
+66 SET INSRCH("IND")=$SELECT('INSRCH("INORDER"):INSRCH("INEND"),1:INSRCH("INSTART"))
+67 ; set flag for transaction search under error search
+68 FOR X="INMSGSTART","INMSGEND","INID","INDIR","INPAT","INSOURCE"
IF $DATA(INSRCH(X))
SET INSRCH("MESSAGEREQ")=1
QUIT
+69 ; system settings, min is 20000
+70 SET INX=$PIECE($GET(^INRHSITE(1,0)),U,14)
SET INSRCH("SPACE")=$SELECT(INX>20000:INX,1:20000)
+71 QUIT INDA
+72 ;
LOCK(INGLB,INDA,INMODE,INTIME,INOPT,INCLR) ; lock file entry
+1 ;
+2 ; Description: Lock and Unlock entries in a global and track
+3 ; incremental locks
+4 ;
+5 ; Return:
+6 ; TRUE = success
+7 ; FAILSE = faild
+8 ; Parameters:
+9 ; INGLB = file number or global base ref ie; "^DIC(3,"
+10 ; INDA = entry in criteria file to lock (req)
+11 ; INMODE = 1 to lock and 0 to unlock 0 is default
+12 ; INTIME = timeout value, defaults to DTIME or 5 sec if
+13 ; DTIME is not around.
+14 ; INOPT = INOPT("LOCK", is where the lock array in kept
+15 ; INOPT("LOCK",INGLB,INDA)=num_of_locks
+16 ; INCLR = optional. 0 or not used will do nothing extra
+17 ; if 1, will clear all locks in INOPT("LOCK",INGLB)
+18 ; if 2, will clear all locks in INOPT("LOCK")
+19 ;
+20 ; check for req values, set defaults
+21 IF '$LENGTH($GET(INGLB))
QUIT 0
IF '$GET(INDA)
QUIT 0
IF '$DATA(INTIME)
SET INTIME=$GET(DTIME,5)
SET INMODE=+$GET(INMODE)
+22 ; if numeric, get global base ref from FM
+23 IF INGLB=+INGLB
SET INGLB=$GET(^DIC(INGLB,0,"GL"))
IF '$LENGTH($GET(INGLB))
QUIT 0
+24 ; if clearing locks do recursive unlock and quit
+25 IF $GET(INCLR)
Begin DoDot:1
+26 NEW ING,INY,INN
+27 ; loop thru globals
+28 SET ING=0
FOR
SET ING=$ORDER(INOPT("LOCK",ING))
IF '$LENGTH(ING)
QUIT
Begin DoDot:2
+29 ; loop thru iens
+30 SET INY=0
FOR
SET INY=$ORDER(INOPT("LOCK",ING,INY))
IF 'INY
QUIT
Begin DoDot:3
+31 ; loop thru num_of_locks
+32 SET INN=INOPT("LOCK",ING,INY)
FOR
SET INN=INN-$$LOCK(ING,INY,0)
End DoDot:3
End DoDot:2
End DoDot:1
QUIT
+33 NEW INODE,INT
SET INODE=INGLB_INDA_")"
+34 ; lock entry
+35 IF INMODE
SET INT=0
Begin DoDot:1
+36 LOCK +@INODE:INTIME
IF '$TEST
QUIT
+37 SET INT=1
SET INOPT("LOCK",INGLB,INDA)=$GET(INOPT("LOCK",INGLB,INDA))+1
End DoDot:1
QUIT INT
+38 ; unlock entry
+39 LOCK -@INODE
SET INOPT("LOCK",INGLB,INDA)=$GET(INOPT("LOCK",INGLB,INDA))-1
+40 QUIT 1
+41 ;
