- 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/PSUSUM1.m
r613 r623 1 PSUSUM1 ;BIR/DAM - Summary Report for Provider Extract ; 2/23/07 2:18pm 2 ;;4.0;PHARMACY BENEFITS MANAGEMENT;**12**;MARCH, 2005;Build 19 3 ; 4 ; No DBIA's required. 5 ; 6 EN ;EN CALLED FROM ^PSUDEM4 7 ; 8 D PULL^PSUCP 9 D DATE 10 D PRSUM^PSUDEM5 ;Mail message 11 Q 12 ; 13 DATE ;Convert dates to external format 14 ; 15 S %H=$E($H,1,5) ;today's date 16 D YX^%DTC 17 N PSUD S PSUD=Y 18 ; 19 S Y=PSUSDT ;Start date of extract 20 D DD^%DT 21 N PSUS S PSUS=Y 22 ; 23 S Y=PSUEDT ;End date of extract 24 D DD^%DT 25 N PSUE S PSUE=Y 26 ; 27 D SUMM 28 Q 29 ; 30 SUMM ;Compose summary mail message by placing all text into a 31 ;temporary global, designated ^XTMP("PSU_"_PSUJOB,"PSUSUM", 32 ; 33 ; 34 ;Report header 35 I '$D(^XTMP("PSU_"_PSUJOB,"PSUPROV")) D Q 36 .S ^XTMP("PSU_"_PSUJOB,"PSUSUM",1)="No data to report" 37 S ^XTMP("PSU_"_PSUJOB,"PSUSUM",1)="Provider Summary Report "_PSUD 38 S ^XTMP("PSU_"_PSUJOB,"PSUSUM",2)="" ;Blank line 39 S ^XTMP("PSU_"_PSUJOB,"PSUSUM",3)=" "_PSUS_" through "_PSUE 40 S ^XTMP("PSU_"_PSUJOB,"PSUSUM",4)="" 41 S $P(^XTMP("PSU_"_PSUJOB,"PSUSUM",5),"-",80)="" ;Separator Bar 42 S $P(^XTMP("PSU_"_PSUJOB,"PSUSUM",7),"-",80)="" 43 S ^XTMP("PSU_"_PSUJOB,"PSUSUM",8)="" 44 S ^XTMP("PSU_"_PSUJOB,"PSUSUM",9)="IEN Provider Name (SSN) Missing Data" 45 S $P(^XTMP("PSU_"_PSUJOB,"PSUSUM",10),"-",80)="" 46 D PROV 47 ; 48 Q 49 ; 50 PROV ;Gather missing provider data for summary report 51 ; 52 N PSUSSN3,PSUMIS,PSUCL,PSUSS,PSUSP,PSUSUB,PSULN,PSUM 53 S PSUM=0 54 S PSULN=11 55 S PSUIP=0 56 F S PSUIP=$O(^XTMP("PSU_"_PSUJOB,"PSUPROV",PSUIP)) Q:PSUIP="" Q:PSUIP["U" D 57 .I $P($G(^VA(200,PSUIP,"PS")),"^",6)=4 Q ; Exclude if the provider type is "FEE BASIS" (PSU*4*12) 58 .S PSUSSN3=$E($P($G(^XTMP("PSU_"_PSUJOB,"PSUPROV",PSUIP)),U,3),6,9) 59 .I PSUSSN3="" S PSUSSN3="????",PSUMIS="SSN" D NAM ;No SSN 60 .S PSUCL=$P($G(^XTMP("PSU_"_PSUJOB,"PSUPROV",PSUIP)),U,5) 61 .I PSUCL="" S PSUMIS="PROVIDER CLASS" D NAM ;No Class 62 .S PSUSS=$P($G(^XTMP("PSU_"_PSUJOB,"PSUPROV",PSUIP)),U,6) 63 .I PSUSS="" S PSUMIS="SERVICE/SECTION" D NAM ;No Ser/Sec 64 .S PSUSP=$P($G(^XTMP("PSU_"_PSUJOB,"PSUPROV",PSUIP)),U,7) 65 .I PSUSP="" S PSUMIS="SPECIALTY" D NAM ;No Spec 66 .Q:PSUSP["Intern" ;Omit interns from missing subspec. on report 67 .Q:PSUSP["Resident" ;Omit residents from missing subspc. on report 68 .S PSUSUB=$P($G(^XTMP("PSU_"_PSUJOB,"PSUPROV",PSUIP)),U,8) 69 .I PSUSUB="" S PSUMIS="SUBSPECIALTY" D NAM ;No Subsp 70 Q 71 ; 72 NAM ;Get Provider name and create entry line in summary report 73 ; 74 N PSUNAM,PSUT1,PSUT2,PSUT3,PSUT4,S1,S2,S3 75 N PSUT5,PSUT6,PSUT7,PSUT8,PSUT9,PSUT10 76 ; 77 S PSUT4=" " 78 S PSUT1=11 79 S PSUT2=PSUT1-$L(PSUIP) 80 F S1=1:1:(PSUT2-1) S PSUT3(S1)=" " D 81 .S PSUT4=PSUT4_PSUT3(S1) ;First tab position 82 ; 83 S PSUNAM=$P($G(^XTMP("PSU_"_PSUJOB,"PSUPROV",PSUIP)),U,9) 84 ; 85 S PSUT5=" " 86 S PSUT6=54 87 S PSUT7=(PSUT6-$L(PSUNAM)-7-$L(PSUT4)-$L(PSUIP)) 88 F S2=1:1:(PSUT7-1) S PSUT8(S2)=" " D 89 .S PSUT5=PSUT5_PSUT8(S2) ;Second tab position 90 ; 91 S PSUT10=" " 92 F S3=1:1:(PSUT6-1) S PSUT9(S3)=" " D 93 .S PSUT10=PSUT10_PSUT9(S3) ;Third tab position 94 ; 95 ; 96 ;I '$D(^XTMP("PSU_"_PSUJOB,"PSUSUM",PSULN)) D 97 S ^XTMP("PSU_"_PSUJOB,"PSUSUM",PSULN)=PSUIP_PSUT4_PSUNAM_" ("_PSUSSN3_")"_PSUT5_PSUMIS 98 F I=1:1:5 I $P($G(^XTMP("PSU_"_PSUJOB,"PSUSUM",PSULN-I)),U,1)[PSUNAM D 99 .S ^XTMP("PSU_"_PSUJOB,"PSUSUM",PSULN)=PSUT10_PSUMIS 100 ; 101 I $P($G(^XTMP("PSU_"_PSUJOB,"PSUSUM",PSULN)),U,1)[PSUNAM D 102 .S PSUM=PSUM+1 ;Set a counter for number of patients accessed 103 .S ^XTMP("PSU_"_PSUJOB,"PSUSUM",6)="Total Number of Incomplete Provider Records Extracted: "_PSUM 104 S PSULN=PSULN+1 105 ; 106 Q 1 PSUSUM1 ;BIR/DAM - Summary Report for Provider Extract ; 20 DEC 2001 2 ;;4.0;PHARMACY BENEFITS MANAGEMENT;;MARCH, 2005 3 ; 4 ; No DBIA's required. 5 ; 6 EN ;EN CALLED FROM ^PSUDEM4 7 ; 8 D PULL^PSUCP 9 D DATE 10 D PRSUM^PSUDEM5 ;Mail message 11 Q 12 ; 13 DATE ;Convert dates to external format 14 ; 15 S %H=$E($H,1,5) ;today's date 16 D YX^%DTC 17 N PSUD S PSUD=Y 18 ; 19 S Y=PSUSDT ;Start date of extract 20 D DD^%DT 21 N PSUS S PSUS=Y 22 ; 23 S Y=PSUEDT ;End date of extract 24 D DD^%DT 25 N PSUE S PSUE=Y 26 ; 27 D SUMM 28 Q 29 ; 30 SUMM ;Compose summary mail message by placing all text into a 31 ;temporary global, designated ^XTMP("PSU_"_PSUJOB,"PSUSUM", 32 ; 33 ; 34 ;Report header 35 I '$D(^XTMP("PSU_"_PSUJOB,"PSUPROV")) D Q 36 .S ^XTMP("PSU_"_PSUJOB,"PSUSUM",1)="No data to report" 37 S ^XTMP("PSU_"_PSUJOB,"PSUSUM",1)="Provider Summary Report "_PSUD 38 S ^XTMP("PSU_"_PSUJOB,"PSUSUM",2)="" ;Blank line 39 S ^XTMP("PSU_"_PSUJOB,"PSUSUM",3)=" "_PSUS_" through "_PSUE 40 S ^XTMP("PSU_"_PSUJOB,"PSUSUM",4)="" 41 S $P(^XTMP("PSU_"_PSUJOB,"PSUSUM",5),"-",80)="" ;Separator Bar 42 S $P(^XTMP("PSU_"_PSUJOB,"PSUSUM",7),"-",80)="" 43 S ^XTMP("PSU_"_PSUJOB,"PSUSUM",8)="" 44 S ^XTMP("PSU_"_PSUJOB,"PSUSUM",9)="IEN Provider Name (SSN) Missing Data" 45 S $P(^XTMP("PSU_"_PSUJOB,"PSUSUM",10),"-",80)="" 46 D PROV 47 ; 48 Q 49 ; 50 PROV ;Gather missing provider data for summary report 51 ; 52 N PSUSSN3,PSUMIS,PSUCL,PSUSS,PSUSP,PSUSUB,PSULN,PSUM 53 S PSUM=0 54 S PSULN=11 55 S PSUIP=0 56 F S PSUIP=$O(^XTMP("PSU_"_PSUJOB,"PSUPROV",PSUIP)) Q:PSUIP="" Q:PSUIP["U" D 57 .S PSUSSN3=$E($P($G(^XTMP("PSU_"_PSUJOB,"PSUPROV",PSUIP)),U,3),6,9) 58 .I PSUSSN3="" S PSUSSN3="????",PSUMIS="SSN" D NAM ;No SSN 59 .S PSUCL=$P($G(^XTMP("PSU_"_PSUJOB,"PSUPROV",PSUIP)),U,5) 60 .I PSUCL="" S PSUMIS="PROVIDER CLASS" D NAM ;No Class 61 .S PSUSS=$P($G(^XTMP("PSU_"_PSUJOB,"PSUPROV",PSUIP)),U,6) 62 .I PSUSS="" S PSUMIS="SERVICE/SECTION" D NAM ;No Ser/Sec 63 .S PSUSP=$P($G(^XTMP("PSU_"_PSUJOB,"PSUPROV",PSUIP)),U,7) 64 .I PSUSP="" S PSUMIS="SPECIALTY" D NAM ;No Spec 65 .Q:PSUSP["Intern" ;Omit interns from missing subspec. on report 66 .Q:PSUSP["Resident" ;Omit residents from missing subspc. on report 67 .S PSUSUB=$P($G(^XTMP("PSU_"_PSUJOB,"PSUPROV",PSUIP)),U,8) 68 .I PSUSUB="" S PSUMIS="SUBSPECIALTY" D NAM ;No Subsp 69 Q 70 ; 71 NAM ;Get Provider name and create entry line in summary report 72 ; 73 N PSUNAM,PSUT1,PSUT2,PSUT3,PSUT4,S1,S2,S3 74 N PSUT5,PSUT6,PSUT7,PSUT8,PSUT9,PSUT10 75 ; 76 S PSUT4=" " 77 S PSUT1=11 78 S PSUT2=PSUT1-$L(PSUIP) 79 F S1=1:1:(PSUT2-1) S PSUT3(S1)=" " D 80 .S PSUT4=PSUT4_PSUT3(S1) ;First tab position 81 ; 82 S PSUNAM=$P($G(^XTMP("PSU_"_PSUJOB,"PSUPROV",PSUIP)),U,9) 83 ; 84 S PSUT5=" " 85 S PSUT6=54 86 S PSUT7=(PSUT6-$L(PSUNAM)-7-$L(PSUT4)-$L(PSUIP)) 87 F S2=1:1:(PSUT7-1) S PSUT8(S2)=" " D 88 .S PSUT5=PSUT5_PSUT8(S2) ;Second tab position 89 ; 90 S PSUT10=" " 91 F S3=1:1:(PSUT6-1) S PSUT9(S3)=" " D 92 .S PSUT10=PSUT10_PSUT9(S3) ;Third tab position 93 ; 94 ; 95 ;I '$D(^XTMP("PSU_"_PSUJOB,"PSUSUM",PSULN)) D 96 S ^XTMP("PSU_"_PSUJOB,"PSUSUM",PSULN)=PSUIP_PSUT4_PSUNAM_" ("_PSUSSN3_")"_PSUT5_PSUMIS 97 F I=1:1:5 I $P($G(^XTMP("PSU_"_PSUJOB,"PSUSUM",PSULN-I)),U,1)[PSUNAM D 98 .S ^XTMP("PSU_"_PSUJOB,"PSUSUM",PSULN)=PSUT10_PSUMIS 99 ; 100 I $P($G(^XTMP("PSU_"_PSUJOB,"PSUSUM",PSULN)),U,1)[PSUNAM D 101 .S PSUM=PSUM+1 ;Set a counter for number of patients accessed 102 .S ^XTMP("PSU_"_PSUJOB,"PSUSUM",6)="Total Number of Incomplete Provider Records Extracted: "_PSUM 103 S PSULN=PSULN+1 104 ; 105 Q
Note:
See TracChangeset
for help on using the changeset viewer.
