source: FOIAVistA/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGROHLU.m@ 782

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

initial load of FOIAVistA 6/30/08 version
File size: 5.0 KB
Line 
1DGROHLU ;DJH/AMA - ROM HL7 BUILD ORF SEGMENT ; 03 May 2004 12:21 PM
2 ;;5.3;Registration;**533,572**;Aug 13, 1993
3 ;
4 Q
5 ;
6DIQ(DGROFDA,FILE,DFN,DGQRY) ;GATHER THE PATIENT DATA USING GETS^DIQ
7 ;Called from BLDORF^DGROHLQ
8 ; INPUT:
9 ; DGROFDA = ROOT FILE NAME OF TEMP GLOBAL ARRAY, ^TMP("DGROFDA",$J)
10 ; FILE = FILE FROM WHICH TO GATHER THE DATA
11 ; DFN = POINTER TO PATIENT (#2) FILE
12 ; DGQRY = ARRAY OF PARSED "QRY" DATA ;DG*5.3*572
13 ;
14 ; OUTPUT:
15 ; GLOBAL ARRAY OF REQUESTED DATA ELEMENTS, IN DGROFDA
16 ;
17 ;THIS ROUTINE ALSO CHECKS THE DG REGISTER ONCE FIELD DEFINITION
18 ;(#391.23) FILE TO ENSURE EACH DATA ELEMENT IS REQUESTED.
19 ;
20 N U,FLAG,FIELD,TMPFLD,F,IEN,CNT,F1,F2,F3,F4,EIEN,STATEIEN,CNTYIEN,CNTY
21 ;
22 ;BUILD THE INITIAL DATA ELEMENT GLOBAL ARRAY
23 ;* County name is sent instead of number (avoid duplicate on number)
24 ;* Direct global reads of STATE file, COUNTY multiple supported with
25 ;* IA #10056
26 ;
27 S U="^",FLAG="EN" ;*Get External value (DG*5.3*572)
28 S (STATEIEN,CNTYIEN)=""
29 S FILE=0
30 ;
31 F S FILE=$O(^DGRO(391.23,"C",FILE)) Q:'FILE D
32 . I (FILE=2.01)!(FILE=2.02)!(FILE=2.06)!(FILE=2.141) Q
33 . S FIELD=0
34 . F S FIELD=$O(^DGRO(391.23,"C",FILE,FIELD)) Q:'FIELD D
35 . . S (CNTY,CNTYIEN,STATEIEN)=0
36 . . I FILE=2 DO
37 . . . I (FIELD=.117),($D(^DPT(DFN,.11))) DO
38 . . . . S STATEIEN=$P(^DPT(DFN,.11),"^",5)
39 . . . . S CNTYIEN=$P(^DPT(DFN,.11),"^",7)
40 . . . . S:((+STATEIEN>0)&(+CNTYIEN>0)) @DGROFDA@(FILE,DFN,FIELD,"E")=$P(^DIC(5,STATEIEN,1,CNTYIEN,0),"^",1)
41 . . . . S CNTY=1
42 . . . I (FIELD=.12111),($D(^DPT(DFN,.121))) DO
43 . . . . S STATEIEN=$P(^DPT(DFN,.121),"^",5)
44 . . . . S CNTYIEN=$P(^DPT(DFN,.121),"^",11)
45 . . . . S:((+STATEIEN>0)&(+CNTYIEN>0)) @DGROFDA@(FILE,DFN,FIELD,"E")=$P(^DIC(5,STATEIEN,1,CNTYIEN,0),"^",1)
46 . . . . S CNTY=1
47 . . . I (FIELD=.14111),($D(^DPT(DFN,.141))) DO
48 . . . . S STATEIEN=$P(^DPT(DFN,.141),"^",5)
49 . . . . S CNTYIEN=$P(^DPT(DFN,.141),"^",11)
50 . . . . S:((+STATEIEN>0)&(+CNTYIEN>0)) @DGROFDA@(FILE,DFN,FIELD,"E")=$P(^DIC(5,STATEIEN,1,CNTYIEN,0),"^",1)
51 . . . . S CNTY=1
52 . . D:(CNTY=0) GETS^DIQ(FILE,DFN,FIELD,FLAG,DGROFDA)
53 ;
54 ;IF THERE'S NO DATE OF DEATH, KILL ALL OTHER DoD FIELDS
55 I '$D(@DGROFDA@(2,DFN_",",.351)) F FIELD=.351:.001:.355 K @DGROFDA@(2,DFN_",",FIELD)
56 ;
57 ;GET INTERNAL AND EXTERNAL VALUES - ALIAS, RACE, AND ETHNICITY SUB-FILES
58 F FILE=2.01,2.02,2.06,2.141 D
59 . N SBFL,SBDA,SBFLD
60 . S FLAG="IEN" ;*Get Internal and External; no Null values (DG*5.3*572)
61 . S SBFL=FILE-2 I FILE=2.141 S SBFL=.14
62 . S SBDA=0 F S SBDA=$O(^DPT(DFN,SBFL,SBDA)) Q:'SBDA D
63 . . S SBFLD=0 F S SBFLD=$O(^DGRO(391.23,"C",FILE,SBFLD)) Q:'SBFLD D
64 . . . D GETS^DIQ(FILE,SBDA_","_DFN,SBFLD,FLAG,DGROFDA)
65 ;ENSURE THE RACE DATA IS ACTIVE
66 S IEN="" F S IEN=$O(@DGROFDA@(2.02,IEN)) Q:IEN="" D
67 . N RIEN,MIEN
68 . S RIEN=$G(@DGROFDA@(2.02,IEN,.01,"I"))
69 . I $$GET1^DIQ(10,RIEN,200,"I") K @DGROFDA@(2.02,IEN) Q
70 . K @DGROFDA@(2.02,IEN,.01,"I")
71 . K @DGROFDA@(2.02,IEN,.02,"I")
72 ;ENSURE THE ETHNICITY DATA IS ACTIVE
73 S IEN="" F S IEN=$O(@DGROFDA@(2.06,IEN)) Q:IEN="" D
74 . N EIEN,MIEN
75 . S EIEN=$G(@DGROFDA@(2.06,IEN,.01,"I"))
76 . I $$GET1^DIQ(10.2,EIEN,200,"I") K @DGROFDA@(2.06,IEN) Q
77 . K @DGROFDA@(2.06,IEN,.01,"I")
78 . K @DGROFDA@(2.06,IEN,.02,"I")
79 ;
80 ;CHECK FOR SENSITIVE PATIENT; IF SO, THEN PUT THE QUERY SITE (QS)
81 ;USER IN THE NEW PERSON (#200) FILE, RECORD THE ACCESS IN THE
82 ;SECURITY LOG, AND SEND A MAIL BULLETIN TO THE ISO. ;DG*5.3*572
83 I $D(@DGROFDA@(38.1)) D
84 . N DGREMS,DGREMN,DGUSER
85 . S DGREMS=$$IEN^XUAF4(DGQRY("SNDFAC")) ;QS Institution File (#4) IEN
86 . S DGREMN=$P($$NS^XUAF4(DGREMS),U) ;Get QS Station Name
87 . S DGUSER=$TR(DGQRY("USER"),"~",U) ;Get QS user data
88 . ;
89 . ;Build input for New Person File
90 . ;(format: SSN^Name^Station Name^Station #^Remote DUZ^Phone)
91 . S DGUSER=$P(DGUSER,U,1,2)_U_DGREMN_U_DGQRY("SNDFAC")_U_$P(DGUSER,U,3,4)
92 . I '$$PUT^XUESSO1(DGUSER) K @DGROFDA Q
93 . ;
94 . S DUZ=$$FIND1^DIC(200,"","",$P(DGUSER,U),"SSN","")
95 . S EVENT="DGRO ROM QRY/R02 EVENT"
96 . D SETLOG1^DGSEC(DFN,DUZ,0,U_EVENT) ;Create Security Log entry
97 . D BULTIN1^DGSEC(DFN,DUZ,U_EVENT) ;Send ISO mail bulletin
98 Q
99 ;
100FDA(DGWRK,DGCURLIN,DGFS,DGCS,DGRS,DGDATA) ;Download patient data from Last Site Treated
101 ;Called from PARSORF^DGROHLQ3
102 ; Input:
103 ; DGWRK - Root global with all of the patient data segments, ^TMP("DGROHL7",$J)
104 ; DGCNT - Counter for the root global subscript
105 ; DGFS - HL7 field separator
106 ; DGCS - HL7 component separator
107 ; DGRS - HL7 repetition separator
108 ;
109 ; Output:
110 ; DGDATA - Root global for the patient data to upload, ^TMP("DGROFDA",$J)
111 ;
112 N DGSUBS,DGVAL,DGFILE,DGIEN,DGFIELD,DGINT,DGRODA
113 ;
114 S DGCURLIN=DGCURLIN-1
115 F S DGCURLIN=$O(@DGWRK@(DGCURLIN)) Q:'DGCURLIN D
116 . N DGSEG
117 . S DGSEG=$P(@DGWRK@(DGCURLIN,0),DGFS,2)
118 . S DGSUBS=$P(DGSEG,DGRS),DGVAL=$P(DGSEG,DGRS,2)
119 . S DGFILE=$P(DGSUBS,DGCS),DGIEN=$P(DGSUBS,DGCS,2)
120 . S DGFIELD=$P(DGSUBS,DGCS,3),DGINT=$P(DGVAL,DGCS)
121 . ;
122 . I '$D(^DGRO(391.23,"C",DGFILE,DGFIELD)) Q
123 . ;
124 . ;BUILD/STORE EXTERNAL VALUES INTO ;*DG*5.3*572
125 . ; ^TMP("DGROFDA",$J,FILE,IEN,FIELD,"E")=VALUE
126 . S @DGDATA@(DGFILE,DGIEN,DGFIELD,"E")=DGINT
127 Q
Note: See TracBrowser for help on using the repository browser.