source: WorldVistAEHR/trunk/r/TEXT_INTEGRATION_UTILITIES-GMRP-TIU/TIUPUTC1.m@ 1489

Last change on this file since 1489 was 613, checked in by George Lilly, 15 years ago

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