- 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/PSUDEM1.m
r613 r623 1 PSUDEM1 ;BIR/DAM - Patient Demographics Extract ; 20 DEC 2001 2 ;;4.0;PHARMACY BENEFITS MANAGEMENT;**12**;MARCH, 2005;Build 19 3 ; 4 ;DBIA's 5 ; Reference to file #27.11 supported by DBIA 2462 6 ; Reference to file 2 supported by DBIA 10035, 3504 7 ; Reference to file 200 supported by DBIA 10060 8 ; Reference to file 55 supported by DBIA 3502 9 ; Reference to file 4.3 supported by DBIA 2496, 10091 10 ; Reference to file 4 supported by DBIA 10090 11 ; 12 EN ;EN Routine control module 13 ; 14 D DAT 15 I $D(^XTMP("PSUMANL")) D DEM ;Manual entry point DAM 16 I $G(^XTMP("PSU_"_PSUJOB,"PSUPSUMFLAG")) D HL7 ;Auto entry point DAM 17 I '$D(^XTMP("PSU_"_PSUJOB,"PSUFLAG")) D XMD 18 K ^XTMP("PSU_"_PSUJOB,"PSUXMD") 19 ; 20 I $G(^XTMP("PSU_"_PSUJOB,"PSUPSUMFLAG"))=1 D 21 .S PSUOPTS="1,2,3,4,5,6,7,8,9,10,11" 22 .S PSUAUTO=1 23 ; 24 ; 25 D PULL^PSUCP 26 F I=1:1:$L(PSUOPTS,",") S PSUMOD($P(PSUOPTS,",",I))="" 27 ; 28 I $D(PSUMOD(10)) D PDSSN^PSUDEM4 ;pt. demographics provider msg 29 ; 30 K ^XTMP("PSU_"_PSUJOB,"PSUPDFLAG") 31 K ^XTMP("PSU_"_PSUJOB,"PSUDM") 32 K ^XTMP("PSU_"_PSUJOB,"PSUDMX") 33 K PSUDMDFN,PSURAC,PSURDT 34 Q 35 ; 36 HL7 ;This is the Patient Demographics extract that runs only when 37 ;the PSU PBM [AUTO] option is executed. It captures demographic 38 ;information ONLY on new or updated patient. 39 ; 40 ; *** PSU*4.0*12 - BAJ -- added QUIT if NULL 41 F S PSUSDT=$O(^PSUDEM("B",PSUSDT)) Q:PSUSDT="" Q:PSUSDT>PSUEDT D 42 . S I="" 43 . S I=$O(^PSUDEM("B",PSUSDT,I)) Q:I="" 44 . S DFN=$P(^PSUDEM(I,0),U,2) 45 . S ^XTMP("PSU"_PSUJOB,"REXMT",DFN)="" 46 K DFN 47 ; 48 S DFN="" 49 F S (DFN,PSUDMDFN)=$O(^XTMP("PSU"_PSUJOB,"REXMT",DFN)) Q:DFN="" D DEM1 50 ; 51 Q 52 ; 53 DAT ;Date Module 54 ; 55 ;Date extract was run 56 S %H=$H 57 D YMD^%DTC ;Converts $H to FileMan format 58 ; ** S $P(^TMP("PSUDM",$J),U,3)=X ;Set extract date in temp global 59 S PSURDT=X 60 ; 61 Q 62 ; 63 INST ;EN Place institution code sending report into temp global. 64 ;Institution Mailman info is in file 4.3 65 ; 66 S X=$$VALI^PSUTL(4.3,1,217),PSUSNDR=+$$VAL^PSUTL(4,X,99) 67 S $P(^XTMP("PSU_"_PSUJOB,"PSUSITE"),U,1)=PSUSNDR 68 S PSUSIT=PSUSNDR 69 ; 70 S X=PSUSNDR,DIC=40.8,DIC(0)="X",D="C" D IX^DIC ;**1 71 S X=+Y S PSUDIVNM=$$VAL^PSUTL(40.8,X,.01) 72 S $P(^XTMP("PSU_"_PSUJOB,"PSUSITE"),U,2)=PSUDIVNM 73 Q 74 ; 75 DEM ;PULL PATIENT DEMOGRAPHICS. This is run only when user selects 76 ;PSU PBM [MANUAL] option. It gather patient demographic information 77 ;for all patients in the PATIENT file #2. 78 ; 79 ;N PSUREC ;DAM TEST NEW CODE 80 N PSUREC 81 K PSUREC1,PSUREC2,PSUREC3,PSUREC4,PSUREC5,PSUREC6,PSUREC7 82 K PSUREC8,PSUREC9,PSUREC10,PSUREC11,PSUREC12,PSUREC13,PSUREC14 83 K PSUREC15,PSUDOD,VAEL,VADM 84 ; 85 S PSUNAM=0 86 F S PSUNAM=$O(^DPT("B",PSUNAM)) Q:PSUNAM="" D 87 .S PSUDMDFN=0 88 .F S (DFN,PSUDMDFN)=$O(^DPT("B",PSUNAM,PSUDMDFN)) Q:PSUDMDFN="" D DEM1 89 Q 90 ; 91 DEM1 ; 92 K PSUREC,PSUREC1,PSUREC2,PSUREC3,PSUREC4,PSUREC5,PSUREC6,PSUREC7 93 K PSUREC8,PSUREC9,PSUREC10,PSUREC11,PSUREC12,PSUREC13,PSUREC14 94 K PSUREC15,PSUDOD,VAEL,VADM 95 S PSUDOD=$P($G(^DPT(PSUDMDFN,.35)),U,1) I PSUDOD,PSUDOD<2980701 Q 96 Q:'$D(^DPT(PSUDMDFN,0)) S PSUREC1=$G(^DPT(PSUDMDFN,0)) 97 I $P(PSUREC1,U,21)=1 Q 98 I $E($P(PSUREC1,U,9),1,5)="00000" Q 99 D DEM^VADPT 100 D ELIG^VADPT 101 ;RUN DATE 102 S $P(PSUREC,U,3)=PSURDT 103 ;Gender 104 S PSUREC3=$TR($P(PSUREC1,U,2),"^","'"),$P(PSUREC,U,8)=PSUREC3 105 ;SSN 106 S PSUREC4=$TR($P(PSUREC1,U,9),"^","'"),$P(PSUREC,U,12)=PSUREC4 107 ;DOB 108 S PSUREC5=$TR($P(PSUREC1,U,3),"^","'"),$P(PSUREC,U,5)=PSUREC5 109 ;DT PT ENTERED IN FILE 110 S PSUREC6=$TR($P(PSUREC1,U,16),"^","'"),$P(PSUREC,U,16)=PSUREC6 111 S PSUREC7=$G(^PS(55,PSUDMDFN,0)),$P(PSUREC,U,17)=$TR($P(PSUREC7,U,7),"^","'") 112 ;Service Actual/Historical 113 S $P(PSUREC,U,18)=$TR($P(PSUREC7,U,8),"^","'") 114 ;PLACE "^" AT END OF RECORD 115 S $P(PSUREC,U,30)="" 116 ;SITE SENDING DATA 117 S $P(PSUREC,U,2)=PSUSNDR 118 ;RACE 119 S PSUREC8=$P($G(VADM(8)),U,2),$P(PSUREC,U,7)=PSUREC8 120 ;PRIMARY ELIG CODE 121 S PSUREC9=$P($G(VAEL(1)),U,2),$P(PSUREC,U,9)=PSUREC9 122 D PRIO 123 ;MEANS TEST STATUS 124 S PSUREC11=$P($G(VAEL(9)),U,2),$P(PSUREC,U,10)=PSUREC11 125 D MISC 126 ;FIND PATIENT ICN-VMP 127 D ICN 128 ;PATIENT CURRENT AGE 129 S PSUREC12=$G(VADM(4)),$P(PSUREC,U,6)=PSUREC12 130 D ETH 131 S ^XTMP("PSU_"_PSUJOB,"PSUDMX",PSUDMDFN)=$G(PSUREC) 132 Q 133 ; 134 PRIO ;Pull Enrollment Priority 135 ; 136 S PSUEC=0 137 F S PSUEC=$O(^DGEN(27.11,"C",PSUDMDFN,PSUEC)) Q:PSUEC="" D 138 .S PSUREC10=$TR($P($G(^DGEN(27.11,PSUEC,0)),U,7),"^","'") 139 .I PSUREC10'="" S $P(PSUREC,U,11)=PSUREC10 140 Q 141 ; 142 MISC ;Pulls miscellaneous additional info via EN^DIQ1 call 143 ;Pulls Date of Death, ICN, Primary Care Provider SSN, 144 ;Date patient first provided pharmacy care 145 ; 146 N PSUDATMP,PSUDDTMP,PSUDTMPA 147 ; 148 S PSUDTMPA=$$OUTPTPR^SDUTL3(PSUDMDFN) ;Prov IEN^EXTERNAL VALUE in temp variable 149 S PSUDATMP=$P($G(PSUDTMPA),U) ;Prov IEN 150 S $P(PSUREC,U,15)=PSUDATMP 151 I '$D(PSUDATMP)!PSUDATMP=0 S PSUDATMP=99999999999 152 S $P(PSUREC,U,14)=$$GET1^DIQ(200,PSUDATMP,9,"I") ;Prov SSN 153 S $P(PSUREC,U,4)=$S(PSUDOD:PSUDOD\1,1:"") 154 Q 155 ; 156 ICN ;Find patient ICN 157 ;VMP - OIFO BAY PINES;ELR;PSU*3.0*24 158 ; 159 N PSUICN,PSUICN1 160 S PSUICN=$$GETICN^MPIF001(PSUDMDFN) D 161 .I PSUICN'[-1 D 162 ..S $P(PSUREC,U,13)=PSUICN ;ICN 163 Q 164 ; 165 ETH ;Ethnicity and multiple race entries 166 ; 167 S PSUREC14=$P($G(VADM(11,1)),U,2),$P(PSUREC,U,19)=PSUREC14 168 ; 169 S PSURCE=0,C=20,$P(PSUREC,U,C)="" 170 F S PSURCE=$O(VADM(12,PSURCE)) Q:PSURCE="" D ;Race multiple 171 .S PSURAC=$P($G(VADM(12,PSURCE)),U,2),$P(PSUREC,U,C)=PSURAC,C=C+1 172 Q 173 ; 174 XMD ;Format mailman message and send. 175 ; 176 S PSUAB=0,PSUPL=1 177 F S PSUAB=$O(^XTMP("PSU_"_PSUJOB,"PSUDMX",PSUAB)) Q:PSUAB="" D 178 .M ^XTMP("PSU_"_PSUJOB,"PSUDM",PSUPL)=^XTMP("PSU_"_PSUJOB,"PSUDMX",PSUAB) ;Global numerical order 179 .S PSUPL=PSUPL+1 180 ; 181 NEW PSUMAX,PSULC,PSUTMC,PSUTLC,PSUMC 182 S PSUMAX=$$VAL^PSUTL(4.3,1,8.3) 183 S PSUMAX=$S(PSUMAX="":10000,PSUMAX>10000:10000,1:PSUMAX) 184 S PSUMC=1,PSUMLC=0 185 F PSULC=1:1 S X=$G(^XTMP("PSU_"_PSUJOB,"PSUDM",PSULC)) Q:X="" D 186 .S PSUMLC=PSUMLC+1 187 .I PSUMLC>PSUMAX S PSUMC=PSUMC+1,PSUMLC=0,PSULC=PSULC-1 Q ; + message 188 .I $L(X)<235 S ^XTMP("PSU_"_PSUJOB,"PSUXMD",PSUMC,PSUMLC)=X Q 189 .F I=235:-1:1 S Z=$E(X,I) Q:Z="^" 190 .S ^XTMP("PSU_"_PSUJOB,"PSUXMD",PSUMC,PSUMLC)=$E(X,1,I) 191 .S PSUMLC=PSUMLC+1 192 .S ^XTMP("PSU_"_PSUJOB,"PSUXMD",PSUMC,PSUMLC)="*"_$E(X,I+1,999) 193 ; 194 ; Count Lines sent 195 S PSUTLC=0 196 F PSUM=1:1:PSUMC S X=$O(^XTMP("PSU_"_PSUJOB,"PSUXMD",PSUM,""),-1),PSUTLC=PSUTLC+X 197 ; 198 F PSUM=1:1:PSUMC D PDMAIL^PSUDEM5 199 D CONF 200 Q 201 CONF ;Construct globals for confirmation message 202 ; 203 N PSUDIVIS 204 D INST 205 S PSUDIVIS=$P(^XTMP("PSU_"_PSUJOB,"PSUSITE"),U,1) 206 S PSUSUB="PSU_"_PSUJOB 207 S ^XTMP(PSUSUB,"CONFIRM",PSUDIVIS,7,"M")=PSUMC 208 S ^XTMP(PSUSUB,"CONFIRM",PSUDIVIS,7,"L")=PSUTLC 209 Q 210 REC ;EN If "^" is contained in any record, replace it with "'" 211 ; 212 I PSUREC["^" S PSUREC=$TR(PSUREC,"^","'") 213 Q 1 PSUDEM1 ;BIR/DAM - Patient Demographics Extract ; 20 DEC 2001 2 ;;4.0;PHARMACY BENEFITS MANAGEMENT;;MARCH, 2005 3 ; 4 ;DBIA's 5 ; Reference to file #27.11 supported by DBIA 2462 6 ; Reference to file 2 supported by DBIA 10035, 3504 7 ; Reference to file 200 supported by DBIA 10060 8 ; Reference to file 55 supported by DBIA 3502 9 ; Reference to file 4.3 supported by DBIA 2496, 10091 10 ; Reference to file 4 supported by DBIA 10090 11 ; 12 EN ;EN Routine control module 13 ; 14 D DAT 15 I $D(^XTMP("PSUMANL")) D DEM ;Manual entry point DAM 16 I $G(^XTMP("PSU_"_PSUJOB,"PSUPSUMFLAG")) D HL7 ;Auto entry point DAM 17 I '$D(^XTMP("PSU_"_PSUJOB,"PSUFLAG")) D XMD 18 K ^XTMP("PSU_"_PSUJOB,"PSUXMD") 19 ; 20 I $G(^XTMP("PSU_"_PSUJOB,"PSUPSUMFLAG"))=1 D 21 .S PSUOPTS="1,2,3,4,5,6,7,8,9,10,11" 22 .S PSUAUTO=1 23 ; 24 ; 25 D PULL^PSUCP 26 F I=1:1:$L(PSUOPTS,",") S PSUMOD($P(PSUOPTS,",",I))="" 27 ; 28 I $D(PSUMOD(10)) D PDSSN^PSUDEM4 ;pt. demographics provider msg 29 ; 30 K ^XTMP("PSU_"_PSUJOB,"PSUPDFLAG") 31 K ^XTMP("PSU_"_PSUJOB,"PSUDM") 32 K ^XTMP("PSU_"_PSUJOB,"PSUDMX") 33 K PSUDMDFN,PSURAC,PSURDT 34 Q 35 ; 36 HL7 ;This is the Patient Demographics extract that runs only when 37 ;the PSU PBM [AUTO] option is executed. It captures demographic 38 ;information ONLY on new or updated patient. 39 ; 40 F S PSUSDT=$O(^PSUDEM("B",PSUSDT)) Q:PSUSDT>PSUEDT D 41 . S I="" 42 . S I=$O(^PSUDEM("B",PSUSDT,I)) Q:I="" 43 . S DFN=$P(^PSUDEM(I,0),U,2) 44 . S ^XTMP("PSU"_PSUJOB,"REXMT",DFN)="" 45 K DFN 46 ; 47 S DFN="" 48 F S (DFN,PSUDMDFN)=$O(^XTMP("PSU"_PSUJOB,"REXMT",DFN)) Q:DFN="" D DEM1 49 ; 50 Q 51 ; 52 DAT ;Date Module 53 ; 54 ;Date extract was run 55 S %H=$H 56 D YMD^%DTC ;Converts $H to FileMan format 57 ; ** S $P(^TMP("PSUDM",$J),U,3)=X ;Set extract date in temp global 58 S PSURDT=X 59 ; 60 Q 61 ; 62 INST ;EN Place institution code sending report into temp global. 63 ;Institution Mailman info is in file 4.3 64 ; 65 S X=$$VALI^PSUTL(4.3,1,217),PSUSNDR=+$$VAL^PSUTL(4,X,99) 66 S $P(^XTMP("PSU_"_PSUJOB,"PSUSITE"),U,1)=PSUSNDR 67 S PSUSIT=PSUSNDR 68 ; 69 S X=PSUSNDR,DIC=40.8,DIC(0)="X",D="C" D IX^DIC ;**1 70 S X=+Y S PSUDIVNM=$$VAL^PSUTL(40.8,X,.01) 71 S $P(^XTMP("PSU_"_PSUJOB,"PSUSITE"),U,2)=PSUDIVNM 72 Q 73 ; 74 DEM ;PULL PATIENT DEMOGRAPHICS. This is run only when user selects 75 ;PSU PBM [MANUAL] option. It gather patient demographic information 76 ;for all patients in the PATIENT file #2. 77 ; 78 ;N PSUREC ;DAM TEST NEW CODE 79 N PSUREC 80 K PSUREC1,PSUREC2,PSUREC3,PSUREC4,PSUREC5,PSUREC6,PSUREC7 81 K PSUREC8,PSUREC9,PSUREC10,PSUREC11,PSUREC12,PSUREC13,PSUREC14 82 K PSUREC15,PSUDOD,VAEL,VADM 83 ; 84 S PSUNAM=0 85 F S PSUNAM=$O(^DPT("B",PSUNAM)) Q:PSUNAM="" D 86 .S PSUDMDFN=0 87 .F S (DFN,PSUDMDFN)=$O(^DPT("B",PSUNAM,PSUDMDFN)) Q:PSUDMDFN="" D DEM1 88 Q 89 ; 90 DEM1 ; 91 K PSUREC,PSUREC1,PSUREC2,PSUREC3,PSUREC4,PSUREC5,PSUREC6,PSUREC7 92 K PSUREC8,PSUREC9,PSUREC10,PSUREC11,PSUREC12,PSUREC13,PSUREC14 93 K PSUREC15,PSUDOD,VAEL,VADM 94 S PSUDOD=$P($G(^DPT(PSUDMDFN,.35)),U,1) I PSUDOD,PSUDOD<2980701 Q 95 Q:'$D(^DPT(PSUDMDFN,0)) S PSUREC1=$G(^DPT(PSUDMDFN,0)) 96 I $P(PSUREC1,U,21)=1 Q 97 I $E($P(PSUREC1,U,9),1,5)="00000" Q 98 D DEM^VADPT 99 D ELIG^VADPT 100 ;RUN DATE 101 S $P(PSUREC,U,3)=PSURDT 102 ;Gender 103 S PSUREC3=$TR($P(PSUREC1,U,2),"^","'"),$P(PSUREC,U,8)=PSUREC3 104 ;SSN 105 S PSUREC4=$TR($P(PSUREC1,U,9),"^","'"),$P(PSUREC,U,12)=PSUREC4 106 ;DOB 107 S PSUREC5=$TR($P(PSUREC1,U,3),"^","'"),$P(PSUREC,U,5)=PSUREC5 108 ;DT PT ENTERED IN FILE 109 S PSUREC6=$TR($P(PSUREC1,U,16),"^","'"),$P(PSUREC,U,16)=PSUREC6 110 S PSUREC7=$G(^PS(55,PSUDMDFN,0)),$P(PSUREC,U,17)=$TR($P(PSUREC7,U,7),"^","'") 111 ;Service Actual/Historical 112 S $P(PSUREC,U,18)=$TR($P(PSUREC7,U,8),"^","'") 113 ;PLACE "^" AT END OF RECORD 114 S $P(PSUREC,U,30)="" 115 ;SITE SENDING DATA 116 S $P(PSUREC,U,2)=PSUSNDR 117 ;RACE 118 S PSUREC8=$P($G(VADM(8)),U,2),$P(PSUREC,U,7)=PSUREC8 119 ;PRIMARY ELIG CODE 120 S PSUREC9=$P($G(VAEL(1)),U,2),$P(PSUREC,U,9)=PSUREC9 121 D PRIO 122 ;MEANS TEST STATUS 123 S PSUREC11=$P($G(VAEL(9)),U,2),$P(PSUREC,U,10)=PSUREC11 124 D MISC 125 ;FIND PATIENT ICN-VMP 126 D ICN 127 ;PATIENT CURRENT AGE 128 S PSUREC12=$G(VADM(4)),$P(PSUREC,U,6)=PSUREC12 129 D ETH 130 S ^XTMP("PSU_"_PSUJOB,"PSUDMX",PSUDMDFN)=$G(PSUREC) 131 Q 132 ; 133 PRIO ;Pull Enrollment Priority 134 ; 135 S PSUEC=0 136 F S PSUEC=$O(^DGEN(27.11,"C",PSUDMDFN,PSUEC)) Q:PSUEC="" D 137 .S PSUREC10=$TR($P($G(^DGEN(27.11,PSUEC,0)),U,7),"^","'") 138 .I PSUREC10'="" S $P(PSUREC,U,11)=PSUREC10 139 Q 140 ; 141 MISC ;Pulls miscellaneous additional info via EN^DIQ1 call 142 ;Pulls Date of Death, ICN, Primary Care Provider SSN, 143 ;Date patient first provided pharmacy care 144 ; 145 N PSUDATMP,PSUDDTMP,PSUDTMPA 146 ; 147 S PSUDTMPA=$$OUTPTPR^SDUTL3(PSUDMDFN) ;Prov IEN^EXTERNAL VALUE in temp variable 148 S PSUDATMP=$P($G(PSUDTMPA),U) ;Prov IEN 149 S $P(PSUREC,U,15)=PSUDATMP 150 I '$D(PSUDATMP)!PSUDATMP=0 S PSUDATMP=99999999999 151 S $P(PSUREC,U,14)=$$GET1^DIQ(200,PSUDATMP,9,"I") ;Prov SSN 152 S $P(PSUREC,U,4)=$S(PSUDOD:PSUDOD\1,1:"") 153 Q 154 ; 155 ICN ;Find patient ICN 156 ;VMP - OIFO BAY PINES;ELR;PSU*3.0*24 157 ; 158 N PSUICN,PSUICN1 159 S PSUICN=$$GETICN^MPIF001(PSUDMDFN) D 160 .I PSUICN'[-1 D 161 ..S $P(PSUREC,U,13)=PSUICN ;ICN 162 Q 163 ; 164 ETH ;Ethnicity and multiple race entries 165 ; 166 S PSUREC14=$P($G(VADM(11,1)),U,2),$P(PSUREC,U,19)=PSUREC14 167 ; 168 S PSURCE=0,C=20,$P(PSUREC,U,C)="" 169 F S PSURCE=$O(VADM(12,PSURCE)) Q:PSURCE="" D ;Race multiple 170 .S PSURAC=$P($G(VADM(12,PSURCE)),U,2),$P(PSUREC,U,C)=PSURAC,C=C+1 171 Q 172 ; 173 XMD ;Format mailman message and send. 174 ; 175 S PSUAB=0,PSUPL=1 176 F S PSUAB=$O(^XTMP("PSU_"_PSUJOB,"PSUDMX",PSUAB)) Q:PSUAB="" D 177 .M ^XTMP("PSU_"_PSUJOB,"PSUDM",PSUPL)=^XTMP("PSU_"_PSUJOB,"PSUDMX",PSUAB) ;Global numerical order 178 .S PSUPL=PSUPL+1 179 ; 180 NEW PSUMAX,PSULC,PSUTMC,PSUTLC,PSUMC 181 S PSUMAX=$$VAL^PSUTL(4.3,1,8.3) 182 S PSUMAX=$S(PSUMAX="":10000,PSUMAX>10000:10000,1:PSUMAX) 183 S PSUMC=1,PSUMLC=0 184 F PSULC=1:1 S X=$G(^XTMP("PSU_"_PSUJOB,"PSUDM",PSULC)) Q:X="" D 185 .S PSUMLC=PSUMLC+1 186 .I PSUMLC>PSUMAX S PSUMC=PSUMC+1,PSUMLC=0,PSULC=PSULC-1 Q ; + message 187 .I $L(X)<235 S ^XTMP("PSU_"_PSUJOB,"PSUXMD",PSUMC,PSUMLC)=X Q 188 .F I=235:-1:1 S Z=$E(X,I) Q:Z="^" 189 .S ^XTMP("PSU_"_PSUJOB,"PSUXMD",PSUMC,PSUMLC)=$E(X,1,I) 190 .S PSUMLC=PSUMLC+1 191 .S ^XTMP("PSU_"_PSUJOB,"PSUXMD",PSUMC,PSUMLC)="*"_$E(X,I+1,999) 192 ; 193 ; Count Lines sent 194 S PSUTLC=0 195 F PSUM=1:1:PSUMC S X=$O(^XTMP("PSU_"_PSUJOB,"PSUXMD",PSUM,""),-1),PSUTLC=PSUTLC+X 196 ; 197 F PSUM=1:1:PSUMC D PDMAIL^PSUDEM5 198 D CONF 199 Q 200 CONF ;Construct globals for confirmation message 201 ; 202 N PSUDIVIS 203 D INST 204 S PSUDIVIS=$P(^XTMP("PSU_"_PSUJOB,"PSUSITE"),U,1) 205 S PSUSUB="PSU_"_PSUJOB 206 S ^XTMP(PSUSUB,"CONFIRM",PSUDIVIS,7,"M")=PSUMC 207 S ^XTMP(PSUSUB,"CONFIRM",PSUDIVIS,7,"L")=PSUTLC 208 Q 209 REC ;EN If "^" is contained in any record, replace it with "'" 210 ; 211 I PSUREC["^" S PSUREC=$TR(PSUREC,"^","'") 212 Q
Note:
See TracChangeset
for help on using the changeset viewer.
