source: FOIAVistA/trunk/r/PHARMACY_BENEFITS_MANAGEMENT-PSU/PSUSUM1.m@ 1540

Last change on this file since 1540 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 3.6 KB
Line 
1PSUSUM1 ;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 ;
6EN ;EN CALLED FROM ^PSUDEM4
7 ;
8 D PULL^PSUCP
9 D DATE
10 D PRSUM^PSUDEM5 ;Mail message
11 Q
12 ;
13DATE ;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 ;
30SUMM ;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 ;
50PROV ;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 ;
72NAM ;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
Note: See TracBrowser for help on using the repository browser.