source: FOIAVistA/trunk/r/ADVERSE_REACTION_TRACKING-GMRA-GMA/GMRAOR3.m@ 813

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

initial load of FOIAVistA 6/30/08 version

File size: 2.1 KB
Line 
1GMRAOR3 ;HIRMFO/RM,WAA-ORDERABLE LIST UTILITIES ; 2/2/95
2 ;;4.0;Adverse Reaction Tracking;**13**;Mar 29, 1996
3EN1(START,NUM,ARRAY) ; ENTRY POINT WHERE ALL VARIABLES ARE OPTIONAL.
4 ; START IS THE STARTING POINT OF LIST TO BE RETURNED, NUM IS
5 ; THE NUMBER OF ENTRIES FROM STARTING POINT TO INCLUDE IN LIST,
6 ; AND ARRAY IS THE ADDRESS OF THE ARRAY LIST IS TO BE RETURNED.
7 ;
8 K:$G(START)="" START ; Force list to start at "A" and skip num./punc.
9 S START=$G(START,"A"),NUM=$G(NUM),ARRAY=$G(ARRAY,"GMRALST")
10 K ^TMP($J,"GMRALST")
11NODE ;Loop through each file in order of X-ref.
12 ;
13 ; Loop through GMR Allergies file.
14 S GMRAST=START
15 F GMRACNT=1:1 Q:NUM&(GMRACNT>NUM) S GMRAST=$O(^GMRD(120.82,"B",GMRAST)) Q:GMRAST="" S GMRAIEN=$O(^(GMRAST,"")) I GMRAIEN>0 D FILE("ALL",0)
16 ;
17 ; Loop through VA Drug Class file.
18 S GMRAST=START
19 F GMRACNT=1:1 Q:NUM&(GMRACNT>NUM) S GMRAST=$O(^PS(50.605,"C",GMRAST)) Q:GMRAST="" S GMRAIEN=$O(^(GMRAST,"")) I GMRAIEN>0 D FILE("PSC",0)
20 ;
21 ; Loop through NDF File (B X-ref)
22 ; $$B^PSNAPIS returns NDF version dependent root of "B" x-ref
23 S GMRAST=START
24 F GMRACNT=1:1 Q:NUM&(GMRACNT>NUM) S GMRAST=$O(@($$B^PSNAPIS)@(GMRAST)) Q:GMRAST="" S GMRAIEN=$O(^(GMRAST,"")) I GMRAIEN>0 D FILE("NDF",0)
25 ;
26 ; Loop through NDF file (T X-ref)
27 ; $$T^PSNAPIS returns NDF version dependent root of "T" x-ref
28 S GMRAST=START K ^TMP($J,"GMRAT")
29 F GMRACNT=1:1 Q:NUM&(GMRACNT>NUM) S GMRAST=$O(@($$T^PSNAPIS)@(GMRAST)) Q:GMRAST="" S GMRAIEN=$$TGTOG^PSNAPIS(GMRAST) I GMRAIEN>0 D FILE("NDF",1)
30 ; Set the return array.
31 S GMRACNT=1,GMRAST="" F S GMRAST=$O(^TMP($J,"GMRALST",GMRAST)) Q:GMRAST="" D I NUM'="" Q:GMRACNT>NUM
32 .S @ARRAY@(GMRACNT)=^TMP($J,"GMRALST",GMRAST),GMRACNT=GMRACNT+1
33 .Q
34 K ^TMP($J,"GMRALST"),^TMP($J,"GMRAT"),GMRACNT,GMRAIEN,GMRAST
35 Q
36FILE(GMRATAB,GMRAT) ;File away a found entry
37 ; GMRATAB is the table entry in from OE3 HL7 spec.
38 ; GMRAT is (0/1) indicating whether to check for dups of same entry.
39 ;
40 I GMRAT Q:$D(^TMP($J,"GMRAT",GMRAIEN)) S ^(GMRAIEN)=""
41 I '$D(^TMP($J,"GMRALST",GMRAST)) S ^(GMRAST)=GMRAIEN_U_GMRAST_U_"99"_GMRATAB
42 K GMRAT,GMRATAB
43 Q
Note: See TracBrowser for help on using the repository browser.