Routine: TIUPUTC1

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

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      ;

TIUPUTC1.m