source: FOIAVistA/tag/r/PHARMACY_BENEFITS_MANAGEMENT-PSU/PSUVIT1.m@ 636

Last change on this file since 636 was 636, checked in by George Lilly, 14 years ago

WorldVistAEHR overlayed on FOIAVistA
File size: 7.0 KB
Line 
1PSUVIT1 ;BIR/RDC - VITALS & IMMUNIZATION EXTRACT; 24 DEC 2003
2 ;;4.0;PHARMACY BENEFITS MANAGEMENT;;MARCH, 2005
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 ;
75 S PSUVLIST="""BLOOD PRESSURE"",""HEIGHT"",""WEIGHT"",""PAIN"",""PULSE"",""PULSE OXIMETRY"""
76 ;
77 ; ** Loop through date index for valid dates **
78 S PSUDATE=SDATE
79 F S PSUDATE=$O(^GMR(120.5,"B",PSUDATE)) Q:PSUDATE>EDATE!('PSUDATE) D
80 . S PSUV="" ; ** loop thru vitals for each date **
81 . F S PSUV=$O(^GMR(120.5,"B",PSUDATE,PSUV)) Q:PSUV="" D
82 .. Q:$P($D(^GMR(120.5,PSUV,2)),U) ;** quit if vital entered in error **
83 .. S PSUVREC=$G(^GMR(120.5,PSUV,0)) Q:'PSUVREC
84 .. S PSUPTPTR=$P(PSUVREC,U,2) ; ** point to PATIENT **
85 .. Q:$G(^DPT(PSUPTPTR,0))="" ; ** quit if no patient record **
86 .. S PSUPTREC=^DPT(PSUPTPTR,0) ; ** get patient record **
87 .. S PSUSSN=$P(PSUPTREC,U,9) ; ** get SSN
88 .. Q:$E(PSUSSN,1,5)="00000" ; ** quit if invalid patient **
89 .. Q:$P(PSUPTREC,U,21)=1
90 .. Q:$P(PSUVREC,U,3)="" ; ** quit if no pointer **
91 .. S PSUVPTR=$P(PSUVREC,U,3) ; ** point to VITAL **
92 .. S PSUVTYPE=$P(^GMRD(120.51,PSUVPTR,0),U) ; ** get VITAL TYPE **
93 .. Q:PSUVLIST'[PSUVTYPE ; ** screen out invalid vital types **
94 .. S PSURTYPE="V" ; ** set record type **
95 .. S PSUICN=$$GETICN^MPIF001(PSUPTPTR) ; ** get ICN **
96 .. I $P(PSUICN,U)="-1" S PSUICN=""
97 .. S PSUVRATE=$P(PSUVREC,U,8)
98 .. S PSUVUNIT="" ; ** set vital unit rate **
99 .. S:PSUVTYPE="PULSE OXIMETRY" PSUVUNIT="%"
100 .. S:PSUVTYPE="WEIGHT" PSUVUNIT="LBS"
101 .. S:PSUVTYPE="HEIGHT" PSUVUNIT="IN"
102 .. S (PSUVQ1,PSUVQ2,PSUVQ3,PSUVQ4)=""
103 .. D:$D(^GMR(120.5,PSUV,5,0)) ; ** get qualifiers **
104 ... S (PSUQNUM,PSUQCNT)=0
105 ... F S PSUQNUM=$O(^GMR(120.5,PSUV,5,PSUQNUM)) Q:'+PSUQNUM D
106 .... S PSUQPTR=^GMR(120.5,PSUV,5,PSUQNUM,0)
107 .... S PSUQCNT=PSUQCNT+1
108 .... S QQ="PSUVQ"_PSUQCNT
109 .... S @QQ=$P(^GMRD(120.52,PSUQPTR,0),U)
110 .. S Z="$"
111 .. 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
112 .. S PSUVMSG=$TR(PSUVMSG,"^","'")
113 .. S PSUVMSG=$TR(PSUVMSG,Z,U)
114 .. ; ** S PSUVTMP(PSUSSN,PSUVTYPE)=PSUVMSG
115 .. S ^XTMP("PSU_"_PSUJOB,"PSUVI","TMP",PSUSSN,PSUVTYPE)=PSUVMSG
116 Q
117 ; ** end of vital extract **
118VITALS2 ; LOAD SORTED ARRAY INTO ^XTMP
119 ;
120 N VPT,VPTV
121 S VPT=""
122 ; ** F S VPT=$O(PSUVTMP(VPT)) Q:VPT="" D
123 F S VPT=$O(^XTMP("PSU_"_PSUJOB,"PSUVI","TMP",VPT)) Q:VPT="" D
124 . S VPTV=""
125 . ; **F S VPTV=$O(PSUVTMP(VPT,VPTV)) Q:VPTV="" D
126 . F S VPTV=$O(^XTMP("PSU_"_PSUJOB,"PSUVI","TMP",VPT,VPTV)) Q:VPTV="" D
127 .. ; ** S X=PSUVTMP(VPT,VPT ; * LOAD VITAL RECORD
128 .. S X=^XTMP("PSU_"_PSUJOB,"PSUVI","TMP",VPT,VPTV)
129 .. S LINECNT=LINECNT+1
130 .. S LINETOT=LINETOT+1
131 .. I LINECNT>LINEMAX S MSGCNT=$G(MSGCNT)+1,LINECNT=1
132 .. I $L(X)<254 S ^XTMP("PSU_"_PSUJOB,"PSUVI",MSGCNT,LINECNT)=X Q ; load
133 .. F J=254:-1 Q:$E(X,J)="^"
134 .. S ^XTMP("PSU_"_PSUJOB,"PSUVI",MSGCNT,LINECNT)=$E(X,1,J)
135 .. S LINECNT=LINECNT+1
136 .. S LINETOT=LINETOT+1
137 .. S ^XTMP("PSU_"_PSUJOB,"PSUVI",MSGCNT,LINECNT)="*"_$E(X,J,J+253)
138 Q
139 ;
140IMMUNS ;
141 N PSUDATE,ICNT,PSUINUM,PSUIREC,PSUPTPTR,PSUPTREC,PSUSSN,PSUIMPTR
142 N PSUIMM,PSUICN,PSURTYPE,PSUIMSG
143 ;
144 S (PSUMCNT,PSUINUM)=0
145 F S PSUINUM=$O(^AUPNVIMM(PSUINUM)) Q:'PSUINUM D
146 . S PSUIDATE=$P($G(^AUPNVIMM(PSUINUM,12)),"U") ; ** get IMM date **
147 . Q:$P(PSUIDATE,U)="" ; ** quit if date is null **
148 . Q:PSUIDATE<SDATE!(PSUIDATE>EDATE) ; ** quit if date out of range **
149 . S PSUIREC=^AUPNVIMM(PSUINUM,0) ; ** get IMM record **
150 . S PSUPTPTR=$P(PSUIREC,U,2) ; ** pointer to PAT file **
151 . S PSUPTREC=^DPT(PSUPTPTR,0) ; ** get patient record **
152 . S PSUSSN=$P(PSUPTREC,U,9)
153 . Q:$E(PSUSSN,1,5)="00000" ; ** quit if invalid patient **
154 . I $P(PSUPTREC,U,21)=1 Q
155 . S PSUIMPTR=$P(PSUIREC,U) ; ** point to IMM file **
156 . S PSUIMM=$P(^AUTTIMM(PSUIMPTR,0),U) ; ** get IMM name **
157 . S PSUICN=$$GETICN^MPIF001(PSUPTPTR) ; ** set ICN **
158 . I $P(PSUICN,U)="-1" S PSUICN=""
159 . S PSURTYPE="I" ; ** set record type **
160 . S Z="$"
161 . S PSUIMSG=Z_PSUFAC_Z_PSUIDATE_Z_PSURTYPE_Z_PSUSSN_Z_PSUICN_Z_PSUIMM_Z_""_Z_""_Z_""_Z_""_Z_""_Z_""_Z_""_Z_""_Z
162 . S PSUIMSG=$TR(PSUIMSG,"^","'")
163 . S X=$TR(PSUIMSG,Z,U)
164 . ; *** load ^XTMP ***
165 . S LINECNT=LINECNT+1
166 . S LINETOT=LINETOT+1
167 . I LINECNT>LINEMAX S MSGCNT=$G(MSGCNT)+1,LINECNT=1
168 . I $L(X)<254 S ^XTMP("PSU_"_PSUJOB,"PSUVI",MSGCNT,LINECNT)=X Q ; load
169 . F K=254:-1 Q:$E(X,K)="^"
170 . S ^XTMP("PSU_"_PSUJOB,"PSUVI",MSGCNT,LINECNT)=$E(X,1,K)
171 . S LINECNT=LINECNT+1
172 . S LINETOT=LINETOT+1
173 . S ^XTMP("PSU_"_PSUJOB,"PSUVI",MSGCNT,LINECNT)="*"_$E(X,K,K+253)
174 ; *** save message count ***
175 S:$G(MSGCNT) ^XTMP("PSU_"_PSUJOB,"PSUVI","MSGTCNT")=MSGCNT
176 S ^XTMP("PSU_"_PSUJOB,"PSUVI","LINECNT")=LINETOT
177 Q ; ** quit IMMUNS **
178 ;
179MAILIT ; MAIL VITAL & IMMUNIZATION EXTRACT MESSAGES
180 ;
181 D ^PSUVIT2
182 Q ; ** quit for MAILIT **
183 ;
Note: See TracBrowser for help on using the repository browser.