source: WorldVistAEHR/trunk/r/VISTA_OFFICE_EHR-VEPE/VEPERI1A.m@ 767

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

initial load of WorldVistAEHR

File size: 2.1 KB
Line 
1VEPERI1A ;DAOU/WCJ - Incoming HL7 messages ;2-MAY-2005
2 ;;1.0;VOEB;;Jun 12, 2005
3 ;;;VISTA OFFICE/EHR;
4 ;;Per VHA Directive 10-93-142, this routine should not be modified.
5 ;
6 ;**Program Description**
7 ; loads hl7 format from table
8 ;
9 Q
10 ; Load format from dictionary 19904 into a local array that is easier
11 ; to play with. Return a fatal error if table is set up incorrectly.
12 ;
13LOADTBL(COTS,FE,HLF) ;
14 ;
15 N D0,D1,D2,D3,NODE,FILE,FIELD,FIELDS,DATA,DATA2,TMP,SKIPTRAN,SEG,SEQ
16 N FLDLOOP
17 S FE=0
18 ;
19 I COTS="" S FE=$$FATALERR^VEPERI6(1,"SETUP","COTS MISSING") Q
20 I '$D(^VEPER(19904,"B",COTS)) S FE=$$FATALERR^VEPERI6(1,"SETUP","COTS NOT IN TABLE") Q
21 S D0=$O(^VEPER(19904,"B",COTS,""))
22 I '+D0 S FE=$$FATALERR^VEPERI6(1,"SETUP","TABLE 19904 INTERGRITY") Q
23 ;
24 S D1=0 F S D1=$O(^VEPER(19904,D0,1,D1)) Q:'D1!FE D
25 . S SEG=$P($G(^VEPER(19904,D0,1,D1,0)),U)
26 . I SEG="" S FE=$$FATALERR^VEPERI6(1,"SETUP","TABLE 19904 INTERGRITY") Q
27 . S HLF("TBL",SEG)=^VEPER(19904,D0,1,D1,0)
28 . S D2=0 F S D2=$O(^VEPER(19904,D0,1,D1,1,D2)) Q:'D2!FE D
29 .. F NODE=0,1,2 I $D(^VEPER(19904,D0,1,D1,1,D2,NODE)) D Q:FE
30 ... S DATA=^(NODE)
31 ... I NODE=0 D Q:FE
32 .... S SEQ=$P(DATA,U)
33 .... I SEQ="" S FE=$$FATALERR^VEPERI6(1,"SETUP","TABLE 19904 INTERGRITY") Q
34 .... S HLF("TBL",SEG,SEQ,NODE)=DATA
35 .... S D3=0 F S D3=$O(^VEPER(19904,D0,1,D1,1,D2,3,D3)) Q:'D3 D Q:FE
36 ..... S DATA2=$G(^(D3,0)) Q:DATA2=""
37 ..... S FILE=$P(DATA2,U,2),FIELDS=$P(DATA2,U,3),SKIPTRAN=$P(DATA2,U,4)
38 ..... I FILE]"",FIELDS]"" D Q:FE
39 ...... S HLF("TBL",SEG,SEQ,"SETID",D3,FILE,FIELDS)=SKIPTRAN
40 ...... F FLDLOOP=1:1:$L(FIELDS,",") D Q:FE
41 ....... S FIELD=$P(FIELDS,",",FLDLOOP)
42 ....... Q:FIELD=""
43 ....... I $D(HLF("MAP",FILE,FIELD)) S FE=$$FATALERR^VEPERI6(1,"SETUP","TABLE 19904 INTERGRITY, DUPLICATE FIELD MAPPING") Q
44 ....... S HLF("MAP",FILE,FIELD)=SEG_U_SEQ_U_D3_U_$E(SKIPTRAN,FLDLOOP)
45 ....... S TMP=$G(^DD(FILE,FIELD,0))
46 ....... I $P(TMP,U,2)["P" D
47 ........ S HLF("MAP",FILE,FIELD)=HLF("MAP",FILE,FIELD)_U_+$P($P(TMP,U,2),"P",2)_U_$S($P(TMP,U,2)["'":0,1:1)
48 ... I SEQ="" S FE=$$FATALERR^VEPERI6(1,"SETUP","TABLE 19904 INTERGRITY") Q
49 ... I NODE'=0 S HLF("TBL",SEG,SEQ,NODE)=$TR(DATA,"~","^")
50 Q
Note: See TracBrowser for help on using the repository browser.