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

INHOU.m

Go to the documentation of this file. 
  1. INHOU ;JSH,DP; 09 Nov 1999 11:21 ;Output Driver utilities 
  1.  ;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
  1.  ;COPYRIGHT 1991-2000 SAIC
  1.  ;CHCS TOOLS_460; GEN 13; 12-NOV-1997
  1.  ;COPYRIGHT 1988, 1989, 1990 SAIC
  1.  ;
  1. GETLINE(%U,%L,%D,%I,%C) ;Function which returns the next line from a UIF entry
  1.  ;%U = UIF entry #
  1.  ;%L = last line obtained (pass by reference)
  1.  ;%D = variable in which to place the lines of data
  1.  ;%I = increment counter (0:default = YES, 1 = NO)
  1.  ;%C = increment value of %L (pass by reference)
  1.  ;
  1.  K %D
  1.  Q:'$G(%U)!($G(%L)="")
  1.  Q:'$D(^INTHU(%U))
  1.  N L,I S L=%L
  1.  S L=L+1 G:'$D(^INTHU(%U,3,L,0)) GQ
  1.  S %D=^(0) I $E(%D,$L(%D)-3,$L(%D))="|CR|" S %D=$E(%D,1,$L(%D)-4) G GQ
  1.  F I=1:1 Q:'$D(^INTHU(%U,3,L+I,0))  S %D(I)=^(0) I $E(%D(I),$L(%D(I))-3,$L(%D(I)))="|CR|" S %D(I)=$E(%D(I),1,$L(%D(I))-4) K:%D(I)="" %D(I) Q
  1.  S L=L+I
  1. GQ S %C=L-%L S:'$G(%I) %L=L Q
  1.  ;
  1. GET(%U,%I) ;Get a line from message - internal call
  1.  ;%U = UIF entry #
  1.  ;%I = increment counter (0:default = YES, 1 = NO)
  1.  ;On entry: LCT = current line position
  1.  ;On exit:  CNT = # of lines incremented
  1.  ;          LINE= array containing the line (killed if no more)
  1.  ;
  1.  K LINE Q:'$G(%U)  Q:'$D(^INTHU(%U))
  1.  N L,I S L=LCT
  1.  S L=L+1 G:'$D(^INTHU(%U,3,L,0)) GQ2
  1.  S LINE=^(0) I $E(LINE,$L(LINE)-3,$L(LINE))="|CR|" S LINE=$E(LINE,1,$L(LINE)-4) G GQ2
  1.  F I=1:1 Q:'$D(^INTHU(%U,3,L+I,0))  S LINE(I)=^(0) I $E(LINE(I),$L(LINE(I))-3,$L(LINE(I)))="|CR|" S LINE(I)=$E(LINE(I),1,$L(LINE(I))-4) K:LINE(I)="" LINE(I) Q
  1.  S L=L+I
  1. GQ2 S CNT=L-LCT S:'$G(%I) LCT=L Q
  1.  ;
  1. GL(%U,%L) ;Function which returns first 250 characters of the next line from a UIF entry
  1.  ;%U = UIF entry #
  1.  ;%L = last line obtained
  1.  Q:'$G(%U)!($G(%L)="") ""
  1.  Q:'$D(^INTHU(%U)) ""
  1.  N L S L=$G(^INTHU(%U,3,%L+1,0))
  1.  S:$E(L,$L(L)-3,$L(L))="|CR|" L=$E(L,1,$L(L)-4)
  1.  Q L
  1.  ;
  1. NOL(UIF) ;Function to return the number of lines for Entry #UIF
  1.  N %,I,X Q:'$O(^INTHU(UIF,3,0)) 0
  1.  S %=0 F I=1:1 Q:'$D(^INTHU(UIF,3,I,0))  S X=^(0) S:$E(X,$L(X)-3,$L(X))="|CR|" %=%+1
  1.  Q %
  1.  ;
  1. QTSK ;Display currently queued entries
  1.  D QTSK^INHOU3
  1.  Q
  1.  ;
  1. REQ ;Reque an Entry for processing
  1.  ;Description:  Requeue Interfacee Transactions
  1.  ; Return= none
  1.  ; Parameters = none
  1.  ;Code Begins
  1.  D REQ^INHOU1
  1.  Q
  1. REQ1 ;Reque an Entry for processing
  1.  ;Description: REQ ( Requeue Interfacee Transactions )
  1.  ; Return = none
  1.  ; Parameters = none
  1.  ; Code Begins
  1.  D REQ1^INHOU1
  1.  Q
  1.  ;
  1. VERIFY() ;Function returns a 1 if OUTPUT CONTROLLER is running, 0 otherwise
  1.  N X S X=$$VER^INHB(1) Q $S(X=1:1,1:0)
  1.  ;
  1. EDIT ;Edit a message in an ERROR state
  1.  N DIC,INY,DES,DWFILE,PRIO,DDSPARM,DDSAVE
  1.  S DIC=4001,DIC(0)="QAEMZ",DIC("A")="Select Transaction to Edit: "
  1.  D ^DIC Q:Y<0  S (Y,INY)=+Y
  1.  S DES=$P(Y(0),U,2)
  1.  I $G(^INRHD(+DES,"ED"))]"" S DWFILE="" X ^("ED") G EDIT1
  1.  S DDSPARM="SC"
  1.  S DIE=4001,DA=INY D EDIT^INHT("INH MESSAGE EDIT")
  1. EDIT1 Q:'$D(DWFILE)&'$G(DDSSAVE)  ;IHS check
  1.  ; Set USER WHO EDITED field, get priority
  1.  S $P(^INTHU(INY,2),U,3)=DUZ,PRIO=+$P(^(0),U,16)
  1.  S X=$$YN^UTSRD("Requeue for Output? ;1",""),Y=INY G:X REQ1
  1.  Q
  1.  ;
  1. MC ;Mark as complete (need INH MESSAGE EDIT key to do this)
  1.  D MC^INHOU4
  1.  Q
  1.  ;
  1. NEXT(%D) ;Function to return next UIF entry queued
  1.  ;%D = entry # of destination [required]
  1.  Q:'$G(%D)  N P
  1.  S P=$O(^INLHSCH("DEST",%D,"")) Q:P="" ""
  1.  Q $O(^INLHSCH("DEST",%D,P,""))
  1.  ;
  1. UPDATE(%U,%S,%M)        ;Update status of a transaction
  1.  ;%U = UIF entry # (file #4001) [required]
  1.  ;%S = Status indicator: [required]
  1.  ; 0 = successful (complete - schedule node killed)
  1.  ; 1 = non-fatal error (pending - schedule node not killed)
  1.  ; 2 = fatal error (error - schedule node killed)
  1.  ;%M = message to log [requried if there is an error]
  1.  ;
  1.  Q:'$G(%U)!($G(%S)="")  Q:%S<0!(%S>2)
  1.  Q:'$D(^INTHU(%U))
  1.  N DA,DIE,DR,DEST,H,PRIO
  1.  D ULOG^INHU(%U,$S('%S:"C",%S=1:"P",1:"E"),$G(%M))
  1.  S DIE="^INTHU(",DA=%U,DR=".09////"_$$NOW^UTDT D ^DIE
  1.  S DEST=$P(^INTHU(%U,0),U,2),PRIO=+$P(^INTHU(%U,0),U,16)
  1.  I %S D ENT^INHE(%U,+DEST,$G(%M))
  1.  Q:%S=1
  1.  S H=$G(^INLHSCH("DEST",+DEST,PRIO,%U)) K ^INLHSCH("DEST",+DEST,PRIO,%U)
  1.  K:H ^INLHSCH(PRIO,H,%U)
  1.  Q
  1. CHECKSEG(INSEG,INREQ,INLVL) ; Validate segs for required and unexpected
  1.  ;
  1.  ; Inputs: INSEG - Seg ID
  1.  ;  INREQ - Required Check Flag
  1.  ;  INLVL - Current processing level
  1.  ;  DATA  - Only for Unexpected Seg check. Will contain
  1.  ;   data associated with UIF entry being processed.
  1.  ;   Value will be set by compiled script and assumed
  1.  ;   to exist. When valid entry detected, value reset
  1.  ;   to valid entry
  1.  ;  DELIM - Delimeter used in segs
  1.  ;  LCT   - Line count (current IEN in UIF for processing)
  1.  ;  INDEFSEG array of defined segs for message
  1.  ;   INDEFSEG(seg id, level)=
  1.  ;    1 if repeating
  1.  ;    "" if not repeating
  1.  ;  UIF   - IEN of Universal Interface
  1.  ;   File entry
  1.  ;
  1.  ;Outputs: Function will quit with value =
  1.  ;  0 - Seg not valid for processing in current loop.
  1.  ;      Quit back to prior loop for continued processing.
  1.  ;  1 - Invalid seg, next valid seg located.
  1.  ;      Continue processing in current loop.
  1.  ; Variables: INMATCH  - Seg located which matches search criteria
  1.  ;  INDATA   - Data from UIF entry
  1.  ;  INDONE   - Flag to indicate all UIF entries have
  1.  ;      been searched
  1.  ;  INCURSEG - Seg ID of current seg in process
  1.  ;  INILCT   - Initial UIF entry for processing
  1.  ;  INLOW    - LCT of first occurrence of lower level
  1.  ;      seg, if no higher level is found
  1.  ;
  1.  N INMATCH,INDATA,INDONE,INCURSEG,INILCT,INLOW
  1.  ;
  1.  ; If seg is invalid, and to be ignored by GIS processing,
  1.  ; line count will be incremented to next valid seg entry in
  1.  ; Universal Interface File.
  1.  ;
  1.  ; If unexpected seg check, quit if current seg is expected seg
  1.  I '$G(INREQ) Q:$P(DATA,DELIM)=INSEG 1
  1.  ; If unexpected seg check, no more records to process, quit.
  1.  I '$G(INREQ) Q:$G(DATA)="" 0
  1.  ; Initialize variables
  1.  S (INILCT,LCT)=$G(LCT),(INMATCH,INDONE,INLOW)=0
  1.  ;
  1.  ; If required check, set data=UIF entry
  1.  I $G(INREQ) S DATA=$$GL^INHOU(UIF,LCT)
  1.  ;
  1.  ; Check current seg against processing rules. If appropriate for
  1.  ; higher level processing, quit. Else continue processing additional
  1.  ; segs.
  1.  S INCURSEG=$P($G(DATA),DELIM)
  1.  D CK1 Q:INMATCH 1 I INDONE D DONE Q 0
  1.  ; Loop through interface file to find first occurence of valid seg
  1.  ; for processing.
  1.  F  D GETNEXT,CK1 Q:INMATCH  I INDONE D DONE Q
  1.  I INREQ,'INDONE S LCT=LCT-1
  1.  Q INMATCH=1
  1.  ;
  1. DONE ; If no valid seg found and end of entries or next valid entry is
  1.  ; located, log error if missing required. Indicate next valid UIF entry
  1.  ; (or set to last entry in file if no valid remaining entries), and
  1.  ; Q 0 (no further processing in current loop)
  1.  I $G(INREQ) D ERROR^INHS("Missing required "_INSEG_" segment. Processing aborted.",2) Q
  1.  S:$G(INLOW) LCT=INLOW
  1.  Q
  1. CK1 ;
  1.  ; Quit if last record encountered.
  1.  Q:INDONE
  1.  ; If no value in INCURSEG, out of data. Q
  1.  I $G(INCURSEG)="" S INDONE=1 Q
  1.  ; If current seg ID is what you're looking for, set INMATCH and quit
  1.  I INCURSEG=INSEG S INMATCH=1 S DATA=INDATA Q
  1.  ; Else if current seg ID is not defined in seg definition array,
  1.  ; continue search.
  1.  I '$D(INDEFSEG(INCURSEG)) Q
  1.  ; Else if current seg has definition entry but only at lower
  1.  ; level (higher level number), continue search. (Defined entry at a
  1.  ; lower level indicates dependence on current level seg for
  1.  ; processing).
  1.  I $O(INDEFSEG(INCURSEG,-1))>INLVL S:'$G(INLOW) INLOW=LCT Q
  1.  ; Else if current seg has definition entry at equal or higher
  1.  ; level and is repeating, set INDONE and quit. (This will cause
  1.  ; error to display, and processing to revert to higher level loop
  1.  ; processing for next repeating group.)
  1.  I $D(INDEFSEG(INCURSEG,$O(INDEFSEG(INCURSEG,INLVL+1),-1))) S INDONE=1 Q
  1.  Q
  1. GETNEXT ; Get next entry from UIF
  1.  D GET^INHOU(UIF,0) S INDATA=$G(LINE)
  1.  I INDATA="" S INDONE=1 S:$G(INLOW) LCT=INLOW Q
  1.  S INCURSEG=$P(INDATA,DELIM)
  1.  Q