- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/PHARMACY_BENEFITS_MANAGEMENT-PSU/PSUVIT1.m
r613 r623 1 PSUVIT1 ;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 ; 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 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 ** 133 VITALS2 ; 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 ; 155 IMMUNS ; 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 ; 194 MAILIT ; MAIL VITAL & IMMUNIZATION EXTRACT MESSAGES 195 ; 196 D ^PSUVIT2 197 Q ; ** quit for MAILIT ** 198 ; 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 ;
Note:
See TracChangeset
for help on using the changeset viewer.
