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