[623] | 1 | PSUVIT1 ;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 | ;
|
---|
| 31 | EN ;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 | ;
|
---|
| 43 | SETUP ; 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 | ;
|
---|
| 69 | VITALS ; 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 **
|
---|
| 118 | VITALS2 ; 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 | ;
|
---|
| 140 | IMMUNS ;
|
---|
| 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 | ;
|
---|
| 179 | MAILIT ; MAIL VITAL & IMMUNIZATION EXTRACT MESSAGES
|
---|
| 180 | ;
|
---|
| 181 | D ^PSUVIT2
|
---|
| 182 | Q ; ** quit for MAILIT **
|
---|
| 183 | ;
|
---|