TIUPUTC1 ; SLC/JER - Document filer Cont'd - captioned header ;27-SEP-1999 12:28:28
;;1.0;TEXT INTEGRATION UTILITIES;**81**;Jun 20, 1997
;IHS/ITSC/LJF 02/26/2003 added code setting TITLE variable
; added code to skip fields if blank and not required
;
GETREC(HEADER,RECORD,TIUHDR) ; ---- Look-up/create record (if LAYGO allowed)
N DIC,DLAYGO,TIUD1,TIUD4,TIUKEY,X,Y
K TIUTITLE ;IHS/ITSC/LJF 02/26/2003 added kill
I '$D(ZTQUEUED) W !!,">>> HEADER IDENTIFIED:",!,HEADER
S X=$$STRIP^TIULS($P(HEADER,":",2)),Y=$$WHATYPE^TIUPUTU(X)
I +Y'>0 D MAIN^TIUPEVNT(DA,1,3,X) D Q
. W:'$D(ZTQUEUED) !!,"INVALID DOCUMENT TYPE ",X,".",!
. S ^TMP("TIUPUTC",$J,"FAIL")=+$G(^TMP("TIUPUTC",$J,"FAIL"))+1
S TIUD1=$G(^TIU(8925.1,+Y,1)),TIUD4=$G(^TIU(8925.1,+Y,4))
S RECORD("TYPE")=+Y,RECORD("FILE")=$P(TIUD1,U)
S RECORD("BOILON")=$P(TIUD1,U,4)
I RECORD("FILE")']"" D MAIN^TIUPEVNT(DA,1,4,X) D Q
. W:'$D(ZTQUEUED) !!,"TARGET FILE NOT DEFINED FOR ",X,".",!
. S ^TMP("TIUPUTC",$J,"FAIL")=+$G(^TMP("TIUPUTC",$J,"FAIL"))+1
S RECORD("ROOT")=$G(^DIC(+RECORD("FILE"),0,"GL"))
I $P(TIUD1,U,3)']"" D MAIN^TIUPEVNT(DA,1,5,X) D Q
. W:'$D(ZTQUEUED) !!,"TEXT FIELD NOT DEFINED FOR ",X,".",!
. S ^TMP("TIUPUTC",$J,"FAIL")=+$G(^TMP("TIUPUTC",$J,"FAIL"))+1
I $P(TIUD1,U,3)]"" D
. ; ---- Get subscript of target file TEXT field
. S RECORD("TEXT")=$P($P(TIUD1,U,3),";",2)
. I RECORD("TEXT")]"",'+RECORD("TEXT") S RECORD("TEXT")=""""_RECORD("TEXT")_""""
F D Q:TIULINE[TIUBGN!(+TIUI'>0)
. N TIUNOD,TIUCAP,TIUVAR,TIUFIELD,TIUREQ S TIUREQ=0
. ; ---- Reset TIUI and Write out transferred header info:
. S TIUI=$O(^TIU(8925.2,+DA,"TEXT",TIUI)) Q:+TIUI'>0
. S TIULINE=$G(^TIU(8925.2,+DA,"TEXT",TIUI,0)) Q:TIULINE[TIUBGN
. I '$D(ZTQUEUED) W !,TIULINE
. ; ---- Check for field number, required missing fields:
. S TIUCAP=$P(TIULINE,":") Q:TIUCAP']""
. S TIUNOD=$O(^TIU(8925.1,+RECORD("TYPE"),"HEAD","B",TIUCAP,0)) Q:+TIUNOD'>0
. ;
. ;IHS/ITSC/LJF 02/26/2003 if item blank and not required, skip
. I $$STRIP^XLFSTR($P(TIULINE,":",2,99)," ")="",$P(^TIU(8925.1,+RECORD("TYPE"),"HEAD",+TIUNOD,0),U,7)'=1 Q
. ;
. S TIUFIELD=$P(^TIU(8925.1,+RECORD("TYPE"),"HEAD",+TIUNOD,0),U,3)
. I TIUFIELD']"" W:'$D(ZTQUEUED) !,"Field Number NOT SPECIFIED for ",TIUCAP Q
. S TIUREQ=$P(^TIU(8925.1,+RECORD("TYPE"),"HEAD",+TIUNOD,0),U,7)
. S TIUHDR(TIUFIELD)=$$STRIP^TIULS($P(TIULINE,":",2,99))
. I +TIUREQ,TIUHDR(TIUFIELD)="" S TIUHDR(TIUFIELD)="** REQUIRED FIELD MISSING FROM UPLOAD **"
. ; ---- Get local lookup variables for document type:
. S TIUVAR=$P(^TIU(8925.1,+RECORD("TYPE"),"HEAD",+TIUNOD,0),U,4) Q:TIUVAR']""
. S TIUHDR(TIUVAR)=$$STRIP^TIULS($P(TIULINE,":",2,99))
I '$D(ZTQUEUED) W !,TIUBGN,!
S:+$P(TIUD1,U,2) DLAYGO=RECORD("FILE")
; ---- If a LOOKUP METHOD is defined for a given document type,
; then set lookup variables and call it:
I $G(TIUD4)]"" D Q
. N TIUJ,TIUVAR,TIUNOD S TIUVAR="A"
. F S TIUVAR=$O(TIUHDR(TIUVAR)) Q:TIUVAR="" D
. . S TIUJ=+$G(TIUJ)+1,TIUVAR(TIUJ)=TIUVAR
. . S @TIUVAR=TIUHDR(TIUVAR)
. I '$D(TIUTITLE) S TIUTITLE=$$STRIP^TIULS($P(HEADER,":",2)) ;IHS/ITSC/LJF 02/26/2003 added
. X TIUD4 S RECORD("#")=+Y
. I +Y'>0 D
. . ; ---- If lookup fails, log 8925.4 error w/ hdr info. Create new
. . ; 8925.2 buffer entry with hdr, text, & 8925.4 log #.
. . ; Kill most of old buffer. Send file error alerts:
. . D MAIN^TIUPEVNT(DA,1,6,$P($G(^TIU(8925.1,+RECORD("TYPE"),0)),U))
. . ;W:'$D(ZTQUEUED) !!,"LOOK-UP FAILED FOR ",X,".",!
. . S ^TMP("TIUPUTC",$J,"FAIL")=+$G(^TMP("TIUPUTC",$J,"FAIL"))+1
. ; ---- Kill local lookup variables:
. S TIUJ=0 F S TIUJ=$O(TIUVAR(TIUJ)) Q:+TIUJ'>0 K @TIUVAR(TIUJ)
; Otherwise set-up for ^DIC call
S DIC=RECORD("FILE"),DIC(0)="MX"
S:+$P(TIUD1,U,2) DIC(0)=DIC(0)_"L"
S:+$G(TIUHDR(.001)) DIC(0)=DIC(0)_"N"
S TIUKEY=$S(+$G(TIUHDR(.001)):+$G(TIUHDR(.001)),1:$G(TIUHDR(.01)))
S X=$S(DIC(0)["N":"`",1:"")_TIUKEY D ^DIC
S RECORD("#")=+Y
I +Y'>0 D
. D MAIN^TIUPEVNT(DA,1,6,$P($G(^TIU(8925.1,+RECORD("TYPE"),0)),U))
. ;W:'$D(ZTQUEUED) !!,"LOOK-UP FAILED FOR ",X,".",!
. S ^TMP("TIUPUTC",$J,"FAIL")=+$G(^TMP("TIUPUTC",$J,"FAIL"))+1
Q
;
TIUPUTC1 ; SLC/JER - Document filer Cont'd - captioned header ;27-SEP-1999 12:28:28
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**81**;Jun 20, 1997
+2 ;IHS/ITSC/LJF 02/26/2003 added code setting TITLE variable
+3 ; added code to skip fields if blank and not required
+4 ;
GETREC(HEADER,RECORD,TIUHDR) ; ---- Look-up/create record (if LAYGO allowed)
+1 NEW DIC,DLAYGO,TIUD1,TIUD4,TIUKEY,X,Y
+2 ;IHS/ITSC/LJF 02/26/2003 added kill
KILL TIUTITLE
+3 IF '$DATA(ZTQUEUED)
WRITE !!,">>> HEADER IDENTIFIED:",!,HEADER
+4 SET X=$$STRIP^TIULS($PIECE(HEADER,":",2))
SET Y=$$WHATYPE^TIUPUTU(X)
+5 IF +Y'>0
DO MAIN^TIUPEVNT(DA,1,3,X)
Begin DoDot:1
+6 IF '$DATA(ZTQUEUED)
WRITE !!,"INVALID DOCUMENT TYPE ",X,".",!
+7 SET ^TMP("TIUPUTC",$JOB,"FAIL")=+$GET(^TMP("TIUPUTC",$JOB,"FAIL"))+1
End DoDot:1
QUIT
+8 SET TIUD1=$GET(^TIU(8925.1,+Y,1))
SET TIUD4=$GET(^TIU(8925.1,+Y,4))
+9 SET RECORD("TYPE")=+Y
SET RECORD("FILE")=$PIECE(TIUD1,U)
+10 SET RECORD("BOILON")=$PIECE(TIUD1,U,4)
+11 IF RECORD("FILE")']""
DO MAIN^TIUPEVNT(DA,1,4,X)
Begin DoDot:1
+12 IF '$DATA(ZTQUEUED)
WRITE !!,"TARGET FILE NOT DEFINED FOR ",X,".",!
+13 SET ^TMP("TIUPUTC",$JOB,"FAIL")=+$GET(^TMP("TIUPUTC",$JOB,"FAIL"))+1
End DoDot:1
QUIT
+14 SET RECORD("ROOT")=$GET(^DIC(+RECORD("FILE"),0,"GL"))
+15 IF $PIECE(TIUD1,U,3)']""
DO MAIN^TIUPEVNT(DA,1,5,X)
Begin DoDot:1
+16 IF '$DATA(ZTQUEUED)
WRITE !!,"TEXT FIELD NOT DEFINED FOR ",X,".",!
+17 SET ^TMP("TIUPUTC",$JOB,"FAIL")=+$GET(^TMP("TIUPUTC",$JOB,"FAIL"))+1
End DoDot:1
QUIT
+18 IF $PIECE(TIUD1,U,3)]""
Begin DoDot:1
+19 ; ---- Get subscript of target file TEXT field
+20 SET RECORD("TEXT")=$PIECE($PIECE(TIUD1,U,3),";",2)
+21 IF RECORD("TEXT")]""
IF '+RECORD("TEXT")
SET RECORD("TEXT")=""""_RECORD("TEXT")_""""
End DoDot:1
+22 FOR
Begin DoDot:1
+23 NEW TIUNOD,TIUCAP,TIUVAR,TIUFIELD,TIUREQ
SET TIUREQ=0
+24 ; ---- Reset TIUI and Write out transferred header info:
+25 SET TIUI=$ORDER(^TIU(8925.2,+DA,"TEXT",TIUI))
IF +TIUI'>0
QUIT
+26 SET TIULINE=$GET(^TIU(8925.2,+DA,"TEXT",TIUI,0))
IF TIULINE[TIUBGN
QUIT
+27 IF '$DATA(ZTQUEUED)
WRITE !,TIULINE
+28 ; ---- Check for field number, required missing fields:
+29 SET TIUCAP=$PIECE(TIULINE,":")
IF TIUCAP']""
QUIT
+30 SET TIUNOD=$ORDER(^TIU(8925.1,+RECORD("TYPE"),"HEAD","B",TIUCAP,0))
IF +TIUNOD'>0
QUIT
+31 ;
+32 ;IHS/ITSC/LJF 02/26/2003 if item blank and not required, skip
+33 IF $$STRIP^XLFSTR($PIECE(TIULINE,":",2,99)," ")=""
IF $PIECE(^TIU(8925.1,+RECORD("TYPE"),"HEAD",+TIUNOD,0),U,7)'=1
QUIT
+34 ;
+35 SET TIUFIELD=$PIECE(^TIU(8925.1,+RECORD("TYPE"),"HEAD",+TIUNOD,0),U,3)
+36 IF TIUFIELD']""
IF '$DATA(ZTQUEUED)
WRITE !,"Field Number NOT SPECIFIED for ",TIUCAP
QUIT
+37 SET TIUREQ=$PIECE(^TIU(8925.1,+RECORD("TYPE"),"HEAD",+TIUNOD,0),U,7)
+38 SET TIUHDR(TIUFIELD)=$$STRIP^TIULS($PIECE(TIULINE,":",2,99))
+39 IF +TIUREQ
IF TIUHDR(TIUFIELD)=""
SET TIUHDR(TIUFIELD)="** REQUIRED FIELD MISSING FROM UPLOAD **"
+40 ; ---- Get local lookup variables for document type:
+41 SET TIUVAR=$PIECE(^TIU(8925.1,+RECORD("TYPE"),"HEAD",+TIUNOD,0),U,4)
IF TIUVAR']""
QUIT
+42 SET TIUHDR(TIUVAR)=$$STRIP^TIULS($PIECE(TIULINE,":",2,99))
End DoDot:1
IF TIULINE[TIUBGN!(+TIUI'>0)
QUIT
+43 IF '$DATA(ZTQUEUED)
WRITE !,TIUBGN,!
+44 IF +$PIECE(TIUD1,U,2)
SET DLAYGO=RECORD("FILE")
+45 ; ---- If a LOOKUP METHOD is defined for a given document type,
+46 ; then set lookup variables and call it:
+47 IF $GET(TIUD4)]""
Begin DoDot:1
+48 NEW TIUJ,TIUVAR,TIUNOD
SET TIUVAR="A"
+49 FOR
SET TIUVAR=$ORDER(TIUHDR(TIUVAR))
IF TIUVAR=""
QUIT
Begin DoDot:2
+50 SET TIUJ=+$GET(TIUJ)+1
SET TIUVAR(TIUJ)=TIUVAR
+51 SET @TIUVAR=TIUHDR(TIUVAR)
End DoDot:2
+52 ;IHS/ITSC/LJF 02/26/2003 added
IF '$DATA(TIUTITLE)
SET TIUTITLE=$$STRIP^TIULS($PIECE(HEADER,":",2))
+53 XECUTE TIUD4
SET RECORD("#")=+Y
+54 IF +Y'>0
Begin DoDot:2
+55 ; ---- If lookup fails, log 8925.4 error w/ hdr info. Create new
+56 ; 8925.2 buffer entry with hdr, text, & 8925.4 log #.
+57 ; Kill most of old buffer. Send file error alerts:
+58 DO MAIN^TIUPEVNT(DA,1,6,$PIECE($GET(^TIU(8925.1,+RECORD("TYPE"),0)),U))
+59 ;W:'$D(ZTQUEUED) !!,"LOOK-UP FAILED FOR ",X,".",!
+60 SET ^TMP("TIUPUTC",$JOB,"FAIL")=+$GET(^TMP("TIUPUTC",$JOB,"FAIL"))+1
End DoDot:2
+61 ; ---- Kill local lookup variables:
+62 SET TIUJ=0
FOR
SET TIUJ=$ORDER(TIUVAR(TIUJ))
IF +TIUJ'>0
QUIT
KILL @TIUVAR(TIUJ)
End DoDot:1
QUIT
+63 ; Otherwise set-up for ^DIC call
+64 SET DIC=RECORD("FILE")
SET DIC(0)="MX"
+65 IF +$PIECE(TIUD1,U,2)
SET DIC(0)=DIC(0)_"L"
+66 IF +$GET(TIUHDR(.001))
SET DIC(0)=DIC(0)_"N"
+67 SET TIUKEY=$SELECT(+$GET(TIUHDR(.001)):+$GET(TIUHDR(.001)),1:$GET(TIUHDR(.01)))
+68 SET X=$SELECT(DIC(0)["N":"`",1:"")_TIUKEY
DO ^DIC
+69 SET RECORD("#")=+Y
+70 IF +Y'>0
Begin DoDot:1
+71 DO MAIN^TIUPEVNT(DA,1,6,$PIECE($GET(^TIU(8925.1,+RECORD("TYPE"),0)),U))
+72 ;W:'$D(ZTQUEUED) !!,"LOOK-UP FAILED FOR ",X,".",!
+73 SET ^TMP("TIUPUTC",$JOB,"FAIL")=+$GET(^TMP("TIUPUTC",$JOB,"FAIL"))+1
End DoDot:1
+74 QUIT
+75 ;
