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

INHUTC6.m

Go to the documentation of this file.
  1. INHUTC6 ;KN,bar; 13 Aug 97 09:18; Interface Message/Error Search
  1. ;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
  1. ;COPYRIGHT 1991-2000 SAIC
  1. ;
  1. ; MODULE NAME: Interface Message/Error Search Part III (INHUTC6)
  1. ;
  1. ; PURPOSE:
  1. ; The purpose of this Message/Error Search module is to provide User/
  1. ; Programmer a generic search functionality into file ^INTHU and
  1. ; ^INTHER . This module contains three subs modules: INHUTC4, INHUTC5
  1. ; and INHUTC6.
  1. ;
  1. ; DESCRIPTION:
  1. ; This sub-module contains function GATHER and BLDLIST
  1. ;
  1. GATHER(INDA,INSRCH) ; Collect search criteria data
  1. ;
  1. ; input: INDA = entry number in INTERFACE CRITERIA file
  1. ; INSRCH = array of search criteria, passed by reference
  1. ; return: INDA if successful
  1. ; Error text if unsuccesful
  1. ;
  1. ; Description: Collects data from the INTERFACE CRITERIA file based
  1. ; on the type of search defined and creates the INSRCH array.
  1. ; Also calculates the start date and end date based on
  1. ; relative (start/end) date and/or absolute (start/end) date.
  1. ;
  1. ; Code begins:
  1. N X,Y,INX,INY,INNODE,INEND,INSTART,INTYPE,INETBL,INMTBL
  1. Q:'$G(INDA) "GATHER: Criteria ien not present."
  1. Q:'$D(^DIZ(4001.1,INDA,0)) "GATHER: Criteria entry not found."
  1. ; Set the constant values for Transaction or Error
  1. S INTYPE=$P(^DIZ(4001.1,INDA,0),U,5)
  1. Q:'$$TYPE^INHUTC2(INTYPE,1) "GATHER: Invalid criteria type for search."
  1. ; update relative dates before we retrieve values
  1. D RELDATE^INHUTC2(INDA)
  1. ;
  1. ;---------- SINGLE VALUE ENTRIES -------------------------------
  1. S INSRCH("TYPE")=INTYPE
  1. 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
  1. S INSRCH("INEND")=$G(^DIZ(4001.1,INDA,1.1))
  1. ; Only set the value for USER and DIVISION if they exist
  1. S X=$G(^DIZ(4001.1,INDA,24))
  1. S:$P(X,U,3) INSRCH("INDIV")=$P(X,U,3)
  1. S:$P(X,U,4) INSRCH("INUSER")=$P(X,U,4)
  1. ;
  1. ;---------- MULTIPLE VALUE ENTRIES ------------------------------
  1. ; Get the multiple in node 31, 32, 33 and 34 indicated by INNODE
  1. S INNODE=30 F INX="MULTIORIG","MULTIDEST","MULTISTAT","MULTIDIV" D
  1. . S INNODE=INNODE+1,INY=0
  1. . F S INY=$O(^DIZ(4001.1,INDA,INNODE,INY)) Q:'INY S X=$G(^(INY,0)) S:$L(X) INSRCH(INX,X)=""
  1. ; text search field
  1. 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))
  1. ; set the search string match type (AND/OR)
  1. S:($D(INSRCH("INTEXT"))>9)&('$D(INSRCH("INTYPE"))) INSRCH("INTYPE")=0
  1. ;
  1. ;---------- TRANSACTION SPECIFIC --------------------------------
  1. I INTYPE="TRANSACTION" S INSRCH("FILENAME")="^INTHU",INSRCH("FILENUM")=4001,INSRCH("MSG")="MESSAGE"
  1. ;
  1. ;---------- ERROR SPECIFIC --------------------------------------
  1. I INTYPE="ERROR" D
  1. . S INSRCH("FILENAME")="^INTHER",INSRCH("FILENUM")=4003,INSRCH("MSG")="ERROR"
  1. . ; Loop through node 15 and get all value for error criteria
  1. . S INX=$G(^DIZ(4001.1,INDA,15)),INY=0
  1. . F X="INMSGSTART","INMSGEND","INERLOC","INERSTAT" S INY=INY+1,Y=$P(INX,U,INY) S:$L(Y) INSRCH(X)=Y
  1. . ; build table values for later use in display
  1. . D CODETBL^INHERR3("INETBL",4003,.1),CODETBL^INHERR3("INMTBL",4001,.03)
  1. . M INSRCH("INETBL")=INETBL,INSRCH("INMTBL")=INMTBL
  1. ;
  1. ;---------- DATE MANIPULATION -----------------------------------
  1. ; obtain Date information
  1. S INSTART=$G(INSRCH("INSTART")),INEND=$G(INSRCH("INEND"))
  1. D GETDATE^INHERR4(.INSTART,.INEND)
  1. S INSRCH("INSTART")=INSTART,INSRCH("INEND")=INEND
  1. ; Get the auxiliary date for error
  1. I INTYPE="ERROR",$D(INSRCH("INMSGSTART"))!$D(INSRCH("INMSGEND")) D
  1. . S INSTART=$G(INSRCH("INMSGSTART")),INEND=$G(INSRCH("INMSGEND"))
  1. . D GETDATE^INHERR4(.INSTART,.INEND)
  1. . S INSRCH("INMSGSTART")=INSTART,INSRCH("INMSGEND")=INEND
  1. ; Set Indicator for search starting point and direction
  1. S:'$G(INSRCH("INORDER")) (INSRCH("INORDER"),^DIZ(4001.1,INDA,11))=0
  1. S INSRCH("IND")=$S('INSRCH("INORDER"):INSRCH("INEND"),1:INSRCH("INSTART"))
  1. ; set flag for transaction search under error search
  1. F X="INMSGSTART","INMSGEND","INID","INDIR","INPAT","INSOURCE" I $D(INSRCH(X)) S INSRCH("MESSAGEREQ")=1 Q
  1. ; system settings, min is 20000
  1. S INX=$P($G(^INRHSITE(1,0)),U,14),INSRCH("SPACE")=$S(INX>20000:INX,1:20000)
  1. Q INDA
  1. ;
  1. LOCK(INGLB,INDA,INMODE,INTIME,INOPT,INCLR) ; lock file entry
  1. ;
  1. ; Description: Lock and Unlock entries in a global and track
  1. ; incremental locks
  1. ;
  1. ; Return:
  1. ; TRUE = success
  1. ; FAILSE = faild
  1. ; Parameters:
  1. ; INGLB = file number or global base ref ie; "^DIC(3,"
  1. ; INDA = entry in criteria file to lock (req)
  1. ; INMODE = 1 to lock and 0 to unlock 0 is default
  1. ; INTIME = timeout value, defaults to DTIME or 5 sec if
  1. ; DTIME is not around.
  1. ; INOPT = INOPT("LOCK", is where the lock array in kept
  1. ; INOPT("LOCK",INGLB,INDA)=num_of_locks
  1. ; INCLR = optional. 0 or not used will do nothing extra
  1. ; if 1, will clear all locks in INOPT("LOCK",INGLB)
  1. ; if 2, will clear all locks in INOPT("LOCK")
  1. ;
  1. ; check for req values, set defaults
  1. Q:'$L($G(INGLB)) 0 Q:'$G(INDA) 0 S:'$D(INTIME) INTIME=$G(DTIME,5) S INMODE=+$G(INMODE)
  1. ; if numeric, get global base ref from FM
  1. I INGLB=+INGLB S INGLB=$G(^DIC(INGLB,0,"GL")) Q:'$L($G(INGLB)) 0
  1. ; if clearing locks do recursive unlock and quit
  1. I $G(INCLR) D Q
  1. . N ING,INY,INN
  1. . ; loop thru globals
  1. . S ING=0 F S ING=$O(INOPT("LOCK",ING)) Q:'$L(ING) D
  1. .. ; loop thru iens
  1. .. S INY=0 F S INY=$O(INOPT("LOCK",ING,INY)) Q:'INY D
  1. ... ; loop thru num_of_locks
  1. ... S INN=INOPT("LOCK",ING,INY) F S INN=INN-$$LOCK(ING,INY,0)
  1. N INODE,INT S INODE=INGLB_INDA_")"
  1. ; lock entry
  1. I INMODE S INT=0 D Q INT
  1. . L +@INODE:INTIME E Q
  1. . S INT=1,INOPT("LOCK",INGLB,INDA)=$G(INOPT("LOCK",INGLB,INDA))+1
  1. ; unlock entry
  1. L -@INODE S INOPT("LOCK",INGLB,INDA)=$G(INOPT("LOCK",INGLB,INDA))-1
  1. Q 1
  1. ;