- 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 ;