source: FOIAVistA/trunk/r/PHARMACY_BENEFITS_MANAGEMENT-PSU/PSUAA1.m@ 1540

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

initial load of FOIAVistA 6/30/08 version

File size: 3.6 KB
Line 
1PSUAA1 ;BIR/RDC - ALLERGY/ADVERSE EVENT EXTRACT ; 23 FEB 2004
2 ;;4.0;PHARMACY BENEFITS MANAGEMENT;**10**;MARCH, 2005;Build 4
3 ;
4 ; Reference to file #4 supported by DBIA 10090
5 ; Reference to file #2 supported by DBIA 10035 AND 3504
6 ; Reference to file #120.8 supported by DBIA 10099, 2422, AND 4562
7 ; Reference to file #120.85 supported by DBIA 10099
8 ; Reference to file #49 supported by DBIA 432
9 ;
10EN ;
11 N ARTMP,DFN,EDATE,GMRA,GMRACT,GMRAL,GMREC,ICN,K,LINECNT,LINEMAX,LINETOT,MSGCNT,NPTR,OPTR,OREC,PN,PREC,RPTR,RRDT,RREC,SDATE,SSN,STAT5ION,V,VPTR,X,Z
12 K PSUMKFLG
13 ;
14 D INITZ
15 D GETRECS
16 D ^PSUAA2
17 Q
18 ;
19INITZ ;
20 ; ** new all non-namespaced variables **
21 ;
22 S SDATE=PSUSDT\1-.0001
23 S EDATE=PSUEDT\1+.2359
24 ;
25 S LINEMAX=$$VAL^PSUTL(4.3,1,8.3)
26 S:LINEMAX=""!(LINEMAX>10000) LINEMAX=10000
27 S LINECNT=999999
28 S LINETOT=0
29 ;
30 S PSUFAC=PSUSNDR
31 ;
32 ; ** get station number **
33 S X=$$VALI^PSUTL(4.3,1,217)
34 S STATION=+$$VAL^PSUTL(4,X,99)
35 ;
36 ; ** get run date **
37 S %H=$H
38 D YMD^%DTC
39 S $P(^TMP("PSUAA",$J),U,3)=X
40 ;
41 ;
42 Q ; ** end of partition initialization **
43 ;
44GETRECS ; ; ** extract reactive data **
45 F S SDATE=$O(^GMR(120.8,"V",SDATE)) Q:SDATE>EDATE!('SDATE) D
46 . S VPTR="" ;*** loop through verified dates ***
47 . F S VPTR=$O(^GMR(120.8,"V",SDATE,VPTR)) Q:VPTR="" D
48 .. K GMRACT,GMRAL,GMREC
49 .. S PSUMKFLG=0
50 .. S VREC=^GMR(120.8,VPTR,0)
51 .. S DFN=$P(VREC,U)
52 .. Q:$G(DFN)=""
53 .. Q:$$TESTPAT^VADPT(DFN)=1 ;test patient
54 .. S PREC=$G(^DPT(DFN,0))
55 .. S SSN=$P(PREC,U,9)
56 .. S GMRA="0^1^111"
57 .. D EN1^GMRADPT
58 .. Q:'$D(GMRAL(VPTR))
59 .. S GMREC=GMRAL(VPTR)
60 .. D EN1^GMRAOR2(VPTR,.ARTMP) ; ** load multiple variables **
61 .. S Z="$",OREC=""
62 .. D STATIC
63 .. S V="" F S V=$O(GMRACT("S",V)) Q:V=""!(V=7) D
64 ... S $P(OREC,Z,13+V)=$G(GMRACT("S",V)) ; * symptoms
65 .. S $P(OREC,Z,20)=""
66 .. S V="" F S V=$O(GMRACT("O",V)) Q:V=""!(V=7) D
67 ... S $P(OREC,Z,12)=$P(GMRACT("O",V),U) ; * event date
68 ... S $P(OREC,Z,13)=$P(GMRACT("O",V),U,2) ; * severity
69 ... D MAKE1 S PSUMKFLG=1
70 .. D:'$G(PSUMKFLG) MAKE1 ; ** load ^XTMP with OREC **
71 .. S:$G(MSGCNT) ^XTMP("PSU_"_PSUJOB,"PSUAA","MSGTCNT")=MSGCNT
72 .. S:LINECNT=999999 LINECNT=1
73 .. S:$G(LINECNT) ^XTMP("PSU_"_PSUJOB,"PSUAA","LINECNT")=LINECNT
74 Q
75 ;
76STATIC ; ** set static pieces of record into OREC **
77 ;
78 S $P(OREC,Z,1)=""
79 S $P(OREC,Z,2)=STATION_VPTR ; ** event ID
80 S $P(OREC,Z,3)=SSN ; ** social security #
81 ;
82 S ICN=$$GETICN^MPIF001(DFN) ; ** ICN
83 I $E(ICN,1,2)="-1" S ICN=""
84 S $P(OREC,Z,4)=ICN
85 ;
86 S $P(OREC,Z,5)=$P(GMREC,U,2) ; ** reactant
87 S $P(OREC,Z,6)=$P($P($P(GMREC,U,9),"(",2),",") ; * reactant file #
88 S $P(OREC,Z,7)=$P(GMREC,U,7) ; ** allergy type
89 S $P(OREC,Z,8)=$P(VREC,U,4) ; ** origination date
90 ;
91 S NPTR=$P(VREC,U,5) ; * originator's section/service
92 I NPTR S OPTR=$P($G(^VA(200,NPTR,5)),U,1)
93 I OPTR S $P(OREC,Z,9)=$P(^DIC(49,OPTR,0),U,1)
94 ;
95 S $P(OREC,Z,10)=$P(VREC,U,6) ; ** observed/historical
96 S $P(OREC,Z,11)=$P(VREC,U,14) ; ** mechanism
97 ;
98 Q ; ** end of static variables for a message **
99 ;
100MAKE1 ; ** load one record/message **
101 ;
102 S OREC=$TR(OREC,"^","'")
103 S OREC=$TR(OREC,Z,U)
104 ;
105 S LINECNT=LINECNT+1
106 S LINETOT=LINETOT+1
107 I LINECNT>LINEMAX S MSGCNT=$G(MSGCNT)+1,LINECNT=1
108 I $L(OREC)<254 S ^XTMP("PSU_"_PSUJOB,"PSUAA",MSGCNT,LINECNT)=OREC Q
109 F K=254:-1 Q:$E(OREC,K)="^"
110 S ^XTMP("PSU_"_PSUJOB,"PSUAA",MSGCNT,LINECNT)=$E(OREC,1,K)
111 S LINECNT=LINECNT+1
112 S LINETOT=LINETOT+1
113 S ^XTMP("PSU_"_PSUJOB,"PSUAA",MSGCNT,LINECNT)="*"_$E(OREC,K,K+253)
114 Q
115PRINT ; ALLOW NO PRINTING
116 Q
117 ;
Note: See TracBrowser for help on using the repository browser.