source: FOIAVistA/trunk/r/PHARMACY_BENEFITS_MANAGEMENT-PSU/PSUVIT1.m@ 1397

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

initial load of FOIAVistA 6/30/08 version
File size: 7.7 KB
Line 
1PSUVIT1 ;BIR/RDC - VITALS & IMMUNIZATION EXTRACT; 24 DEC 2003 ; 10/9/07 7:03am
2 ;;4.0;PHARMACY BENEFITS MANAGEMENT;**11**;MARCH, 2005;Build 8
3 ;
4 ;DBIA's
5 ;References to file #4 - the INSTITUTION file
6 ; DBIA 10090 for: the STATION field - #99
7 ;
8 ;References to file #120.5 - the GMRV VITAL MEASUREMENT file
9 ; DBIA 1381 for: the DATE/TIME VITALS TAKEN field - #.01
10 ; the VITAL TYPE field #.03
11 ; the RATE field #1.2
12 ; the QUALIFIER field #5
13 ;
14 ;References to file #120.51- the GMRV VITAL TYPE file
15 ; DBIA 1382 for: the NAME field - #.01
16 ;
17 ;References to file #120.52 - the GMRV VITAL QUALIFIER file
18 ; DBIA 4504 for: the QUALIFIER field #.01
19 ;
20 ;References to file #9000010.11 - the V IMMUNIZATION file
21 ; DBIA 4567 for: the EVENT DATE AND TIME field #1202
22 ; the IMMUNIZATION field #.01
23 ;
24 ;References to file #2 - the PATIENT file
25 ; DBIA 10035 for: the SOCIAL SECURITY NUMBER field #.09
26 ; DBIA 3504 for: the TEST PATIENT INDICATOR field #.6
27 ;
28 ;References to file #9999999.14 - the IMMUNIZATION file
29 ; DBIA 2454 for: the NAME field #.01
30 ;
31EN ;ENtry POINT - Routine control module
32 ;
33 N SDATE,EDATE,PSUFAC,PSUIDATE,PSUQCNT,PSUQNUM
34 N MAXLINE,LINECNT,MSGCNT,I,J,K,Z,LINETOT
35 S PSUVTMP(0)="TEMP ARRAY FOR PSUVIT1 PROCESSING"
36 D SETUP
37 D VITALS
38 D VITALS2
39 D IMMUNS
40 D MAILIT
41 Q ; ** end of routine control module **
42 ;
43SETUP ; SET UP PARTITION FOR VITALS/IMMUNIZATION EXTRACT
44 ;
45 S LINEMAX=$$VAL^PSUTL(4.3,1,8.3) ; ** get maximum line length **
46 S:LINEMAX=""!(LINEMAX>10000) LINEMAX=10000
47 ;
48 ; SET EXTRACT DATE
49 S %H=$H
50 D YMD^%DTC
51 S $P(^TMP("PSUVI",$J),U,3)=X
52 ;
53 ; GET TIME WINDOW
54 S SDATE=PSUSDT\1-.0001
55 S EDATE=PSUEDT\1+.2359
56 ;
57 ; GET FACILITY
58 S PSUFAC=PSUSNDR
59 ;
60 ; SET VARIABLES
61 I $G(^XTMP("PSU_"_PSUJOB,"PSUPSUFLAG"))=1 D ;AUTOJOBED
62 . S PSUOPTS="1,2,3,4,5,6,7,8,9,10,11,12,13"
63 . S PSUAUTO=1
64 S LINECNT=999999
65 S LINETOT=0
66 ;
67 Q ; ** end of SETUP **
68 ;
69VITALS ; EXTRACT VITAL DATA
70 ;
71 N PSUDATE,PSUV,PSUQ,PSUVREC,PSUPTREC,PSUPTPTR,PSUVPTR,PSUQPTR
72 N PSURTYPE,PSUSSN,PSUICN,PSUVTYPE,PSUVRATE,PSUVUNIT
73 N Z,QQ,PSUVQ1,PSUVQ2,PSUVQ3,PSUVQ4,PSUVLIST,PSUVMSG
74 N PSULN,PSUTXT
75 ;
76 S PSUVLIST="""BLOOD PRESSURE"",""HEIGHT"",""WEIGHT"",""PAIN"",""PULSE"",""PULSE OXIMETRY"""
77 ;
78 ; ** Loop through date index for valid dates **
79 S PSUDATE=SDATE
80 ;PSU*4*11 Added null ptr notification.
81 S PSUTXT(1)="The following IEN(s) have a null pointer in the PATIENT (#2) field of"
82 S PSUTXT(2)="the GMRV VITAL MEASUREMENT file (#120.5). Please notify your IRM and"
83 S PSUTXT(3)="submit a remedy ticket for help in evaluating the record."
84 S PSULN=3
85 F S PSUDATE=$O(^GMR(120.5,"B",PSUDATE)) Q:PSUDATE>EDATE!('PSUDATE) D
86 . S PSUV="" ; ** loop thru vitals for each date **
87 . F S PSUV=$O(^GMR(120.5,"B",PSUDATE,PSUV)) Q:PSUV="" D
88 .. Q:$P($D(^GMR(120.5,PSUV,2)),U) ;** quit if vital entered in error **
89 .. S PSUVREC=$G(^GMR(120.5,PSUV,0)) Q:'PSUVREC
90 .. S PSUPTPTR=$P(PSUVREC,U,2) ; ** point to PATIENT **
91 .. I PSUPTPTR="" D Q ; ** quit if no patient pointer **
92 ... S PSULN=PSULN+1
93 ... S PSUTXT(PSULN)=PSUV
94 .. Q:$G(^DPT(PSUPTPTR,0))="" ; ** quit if no patient record **
95 .. S PSUPTREC=^DPT(PSUPTPTR,0) ; ** get patient record **
96 .. S PSUSSN=$P(PSUPTREC,U,9) ; ** get SSN
97 .. Q:$E(PSUSSN,1,5)="00000" ; ** quit if invalid patient **
98 .. Q:$P(PSUPTREC,U,21)=1
99 .. Q:$P(PSUVREC,U,3)="" ; ** quit if no pointer **
100 .. S PSUVPTR=$P(PSUVREC,U,3) ; ** point to VITAL **
101 .. S PSUVTYPE=$P(^GMRD(120.51,PSUVPTR,0),U) ; ** get VITAL TYPE **
102 .. Q:PSUVLIST'[PSUVTYPE ; ** screen out invalid vital types **
103 .. S PSURTYPE="V" ; ** set record type **
104 .. S PSUICN=$$GETICN^MPIF001(PSUPTPTR) ; ** get ICN **
105 .. I $P(PSUICN,U)="-1" S PSUICN=""
106 .. S PSUVRATE=$P(PSUVREC,U,8)
107 .. S PSUVUNIT="" ; ** set vital unit rate **
108 .. S:PSUVTYPE="PULSE OXIMETRY" PSUVUNIT="%"
109 .. S:PSUVTYPE="WEIGHT" PSUVUNIT="LBS"
110 .. S:PSUVTYPE="HEIGHT" PSUVUNIT="IN"
111 .. S (PSUVQ1,PSUVQ2,PSUVQ3,PSUVQ4)=""
112 .. D:$D(^GMR(120.5,PSUV,5,0)) ; ** get qualifiers **
113 ... S (PSUQNUM,PSUQCNT)=0
114 ... F S PSUQNUM=$O(^GMR(120.5,PSUV,5,PSUQNUM)) Q:'+PSUQNUM D
115 .... S PSUQPTR=^GMR(120.5,PSUV,5,PSUQNUM,0)
116 .... S PSUQCNT=PSUQCNT+1
117 .... S QQ="PSUVQ"_PSUQCNT
118 .... S @QQ=$P(^GMRD(120.52,PSUQPTR,0),U)
119 .. S Z="$"
120 .. S PSUVMSG=Z_PSUFAC_Z_PSUDATE_Z_PSURTYPE_Z_PSUSSN_Z_PSUICN_Z_""_Z_PSUVTYPE_Z_PSUVRATE_Z_PSUVUNIT_Z_PSUVQ1_Z_PSUVQ2_Z_PSUVQ3_Z_PSUVQ4_Z
121 .. S PSUVMSG=$TR(PSUVMSG,"^","'")
122 .. S PSUVMSG=$TR(PSUVMSG,Z,U)
123 .. ; ** S PSUVTMP(PSUSSN,PSUVTYPE)=PSUVMSG
124 .. S ^XTMP("PSU_"_PSUJOB,"PSUVI","TMP",PSUSSN,PSUVTYPE)=PSUVMSG
125 ;PSU*4*11 Send null ptr notifications to PBM group.
126 I PSULN>3 D
127 . S XMTEXT="PSUTXT(",XMY("G.PSU PBM")=""
128 . S XMSUB="** PBM vitals extract detected null patient pointer(s) **"
129 . S XMDUZ="Pharmacy Benefits Management Package"
130 . N DIFROM D ^XMD
131 Q
132 ; ** end of vital extract **
133VITALS2 ; LOAD SORTED ARRAY INTO ^XTMP
134 ;
135 N VPT,VPTV
136 S VPT=""
137 ; ** F S VPT=$O(PSUVTMP(VPT)) Q:VPT="" D
138 F S VPT=$O(^XTMP("PSU_"_PSUJOB,"PSUVI","TMP",VPT)) Q:VPT="" D
139 . S VPTV=""
140 . ; **F S VPTV=$O(PSUVTMP(VPT,VPTV)) Q:VPTV="" D
141 . F S VPTV=$O(^XTMP("PSU_"_PSUJOB,"PSUVI","TMP",VPT,VPTV)) Q:VPTV="" D
142 .. ; ** S X=PSUVTMP(VPT,VPT ; * LOAD VITAL RECORD
143 .. S X=^XTMP("PSU_"_PSUJOB,"PSUVI","TMP",VPT,VPTV)
144 .. S LINECNT=LINECNT+1
145 .. S LINETOT=LINETOT+1
146 .. I LINECNT>LINEMAX S MSGCNT=$G(MSGCNT)+1,LINECNT=1
147 .. I $L(X)<254 S ^XTMP("PSU_"_PSUJOB,"PSUVI",MSGCNT,LINECNT)=X Q ; load
148 .. F J=254:-1 Q:$E(X,J)="^"
149 .. S ^XTMP("PSU_"_PSUJOB,"PSUVI",MSGCNT,LINECNT)=$E(X,1,J)
150 .. S LINECNT=LINECNT+1
151 .. S LINETOT=LINETOT+1
152 .. S ^XTMP("PSU_"_PSUJOB,"PSUVI",MSGCNT,LINECNT)="*"_$E(X,J,J+253)
153 Q
154 ;
155IMMUNS ;
156 N PSUDATE,ICNT,PSUINUM,PSUIREC,PSUPTPTR,PSUPTREC,PSUSSN,PSUIMPTR
157 N PSUIMM,PSUICN,PSURTYPE,PSUIMSG
158 ;
159 S (PSUMCNT,PSUINUM)=0
160 F S PSUINUM=$O(^AUPNVIMM(PSUINUM)) Q:'PSUINUM D
161 . S PSUIDATE=$P($G(^AUPNVIMM(PSUINUM,12)),"U") ; ** get IMM date **
162 . Q:$P(PSUIDATE,U)="" ; ** quit if date is null **
163 . Q:PSUIDATE<SDATE!(PSUIDATE>EDATE) ; ** quit if date out of range **
164 . S PSUIREC=^AUPNVIMM(PSUINUM,0) ; ** get IMM record **
165 . S PSUPTPTR=$P(PSUIREC,U,2) ; ** pointer to PAT file **
166 . S PSUPTREC=^DPT(PSUPTPTR,0) ; ** get patient record **
167 . S PSUSSN=$P(PSUPTREC,U,9)
168 . Q:$E(PSUSSN,1,5)="00000" ; ** quit if invalid patient **
169 . I $P(PSUPTREC,U,21)=1 Q
170 . S PSUIMPTR=$P(PSUIREC,U) ; ** point to IMM file **
171 . S PSUIMM=$P(^AUTTIMM(PSUIMPTR,0),U) ; ** get IMM name **
172 . S PSUICN=$$GETICN^MPIF001(PSUPTPTR) ; ** set ICN **
173 . I $P(PSUICN,U)="-1" S PSUICN=""
174 . S PSURTYPE="I" ; ** set record type **
175 . S Z="$"
176 . S PSUIMSG=Z_PSUFAC_Z_PSUIDATE_Z_PSURTYPE_Z_PSUSSN_Z_PSUICN_Z_PSUIMM_Z_""_Z_""_Z_""_Z_""_Z_""_Z_""_Z_""_Z_""_Z
177 . S PSUIMSG=$TR(PSUIMSG,"^","'")
178 . S X=$TR(PSUIMSG,Z,U)
179 . ; *** load ^XTMP ***
180 . S LINECNT=LINECNT+1
181 . S LINETOT=LINETOT+1
182 . I LINECNT>LINEMAX S MSGCNT=$G(MSGCNT)+1,LINECNT=1
183 . I $L(X)<254 S ^XTMP("PSU_"_PSUJOB,"PSUVI",MSGCNT,LINECNT)=X Q ; load
184 . F K=254:-1 Q:$E(X,K)="^"
185 . S ^XTMP("PSU_"_PSUJOB,"PSUVI",MSGCNT,LINECNT)=$E(X,1,K)
186 . S LINECNT=LINECNT+1
187 . S LINETOT=LINETOT+1
188 . S ^XTMP("PSU_"_PSUJOB,"PSUVI",MSGCNT,LINECNT)="*"_$E(X,K,K+253)
189 ; *** save message count ***
190 S:$G(MSGCNT) ^XTMP("PSU_"_PSUJOB,"PSUVI","MSGTCNT")=MSGCNT
191 S ^XTMP("PSU_"_PSUJOB,"PSUVI","LINECNT")=LINETOT
192 Q ; ** quit IMMUNS **
193 ;
194MAILIT ; MAIL VITAL & IMMUNIZATION EXTRACT MESSAGES
195 ;
196 D ^PSUVIT2
197 Q ; ** quit for MAILIT **
198 ;
Note: See TracBrowser for help on using the repository browser.