//NNNNNNS JOB (ALA03),'NNNNNNN NNN NN',CLASS=H,MSGCLASS=H 00010008 /*ROUTE PRINT U5704 00010000 //**********************************************************************00040000 //* JOB NAME: PDS.SASRPW(RPWJOB2) - FORMERLY "J2RRUN97" USED 00060000 //**********************************************************************00060000 //* 00110008 //SO1 EXEC SAS,REGION=6000K,TIME=60 00110008 //*ORK DD SPACE=(CYL,(1500,1500),RLSE),UNIT=(SYSDA,3) 00200000 //WORK DD SPACE=(CYL,(4000)),UNIT=(SYSDA,3) 00200000 //SYSOUT DD DUMMY 00200000 //* 00200000 //* 00200000 //* \/\/\/ PQ RUN: JOB-1 OUTPUT LAST QUALIFIER: FY1996QX: X=1...4. 00200000 //* \/\/\/ AP RUN: JOB-1 OUTPUT LAST QUALIFIER: FY1996XX: XX=01..13. 00200000 //* 00200000 //EDITDAT1 DD DSN=HSQRAN.BRPWD01.EDITDAT1.FY2000Q4,DISP=SHR 00200000 //* \/\/\/ PQ/AP RUN: READ UP TO 4 RATES FILES FOR EACH CLASS. 00200000 //* *** IMPORTANT: READ 1 FILE FOR EACH GLOBAL R-DATE. 00200000 //RATES1C DD DSN=HSQRAN.BRPWD01.RATES1C.JAN1099,DISP=SHR // DD DSN=HSQRAN.BRPWD01.RATES1C.OCT0498,DISP=SHR // DD DSN=HSQRAN.BRPWD01.RATES1C.OCT0597,DISP=SHR //RATESPD DD DSN=HSQRAN.BRPWD01.RATESPD.JAN1099,DISP=SHR 00200000 // DD DSN=HSQRAN.BRPWD01.RATESPD.OCT0498,DISP=SHR 00200000 // DD DSN=HSQRAN.BRPWD01.RATESPD.OCT0597,DISP=SHR 00200000 //RATESSA DD DSN=HSQRAN.BRPWD01.RATESSA.JAN1099,DISP=SHR 00200000 // DD DSN=HSQRAN.BRPWD01.RATESSA.OCT0498,DISP=SHR 00200000 // DD DSN=HSQRAN.BRPWD01.RATESSA.OCT0597,DISP=SHR 00200000 //RATESSB DD DSN=HSQRAN.BRPWD01.RATESSB.JAN1099,DISP=SHR 00200000 // DD DSN=HSQRAN.BRPWD01.RATESSB.OCT0498,DISP=SHR 00200000 // DD DSN=HSQRAN.BRPWD01.RATESSB.OCT0597,DISP=SHR 00200000 //* 00200000 //* \/\/\/ PQ RUN: JOB-2 OUTPUT LAST QUALIFIER: FY1996QX: X=1...4. 00200000 //* \/\/\/ AP RUN: JOB-2 OUTPUT LAST QUALIFIER: FY1996XX: XX=01..13. 00200000 //* 00200000 //*DITDAT2 DD DSN=HSQRAN.BRPWD01.EDITDAT2.FY2000Q4,DISP=SHR 00200000 //*DITDAT2 DD DSN=HSQRAN.BRPWD01.EDITDAT2.FY2000Q4, 00200000 //* DISP=(NEW,CATLG),DCB=(RECFM=FB,LRECL=150,BLKSIZE=6000), 00200000 //* UNIT=SYSDA,SPACE=(CYL,(1000,750),RLSE) 00200000 //* 00200000 //SYSIN DD * 00200000 00210000 **********************************************************************; * \/\/\/\/\/\/\/\/\/ UPDATE SYSTEM PARAMETERS \/\/\/\/\/\/\/ *; %LET RUNTYPE ='PQ' ;*ENTER 2-CHAR ALPHA RUN TYPE: 'PQ' OR 'AP'. *;00210000 %LET FY = 00 ;*ENTER 2-CHAR NUMERIC FY (E.G., 96). *;00210000 %LET PQ = 4 ;*ENTER 1-CHAR NUMERIC QUARTER: 1-4. *;00210000 %LET AP = . ;*ENTER 2-CHAR NUMERIC AP: 01-13 (. IF PQ RUN). *;00210000 %LET RDATE1 =011099; *ENTER RATE DATE (1ST IF RATE CHANGE); *;00210000 %LET RDATE2 =100498; *ENTER 2ND RDATE (REPEAT 1ST IF NONE). *;00210000 %LET RDATE3 =100597; *ENTER 3RD RDATE (REPEAT 2ND IF NONE). *;00210000 %LET RDATE4 =100597; *ENTER 4TH RDATE (REPEAT 3RD IF NONE). *;00210000 %LET RTOL =0.050; *ENTER REL. RATE TOL (E.G., 0.005 = 1/2 PCNT)*;00210000 %LET WTOL =0.050; *ENTER REL. WT/PC TOLERANCE (LBS). *;00210000 **********************************************************************; 00210000 * >>>>>> REMINDER: UPDATE RATE-DATE SPECIFIC CODE IN MODULES IF NEW. ;00110008 00210000 ********************** B E G I N P R O G R A M **********************00210000 ******************** * PARAMETER CHECKS * ********************; DATA _NULL_; 00210000 IF ^(&RUNTYPE='PQ' OR &RUNTYPE='AP') OR 00210000 ^( 0<=&FY<=99) OR ^(1<=&PQ<=4) THEN ABORT; 00210000 IF &RUNTYPE='AP' AND ^(01<=&AP<=13) THEN ABORT; 00210000 IF &RUNTYPE='PQ' AND &AP ^= . THEN ABORT; 00210000 00210000 ********************************* * CREATE EFLAG DESCRIPTION FILE * *********************************; DATA ETYPE; 00210000 LENGTH ETYPE $20.; 00210000 EFLAG=0000; ETYPE='NONE '; OUTPUT; 00210000 EFLAG=0050; ETYPE='MIGRATED-CBCIS-USED-'; OUTPUT; 00210000 EFLAG=0100; ETYPE='NO-CBCIS-FRAME-ENTRY'; OUTPUT; 00210000 EFLAG=1000; ETYPE='NO-RTABLE-ENTRY-----'; OUTPUT; 00210000 EFLAG=1100; ETYPE='NO-RPWCODE-IN-RTABLE'; OUTPUT; 00210000 EFLAG=1200; ETYPE='NONPOS-PCRT-LBRT----'; OUTPUT; 00210000 EFLAG=2000; ETYPE='EMPTY-R-P-OR-W------'; OUTPUT; 00210000 EFLAG=2100; ETYPE='UNEXPECTED-R-P-OR-W-'; OUTPUT; 00210000 EFLAG=2500; ETYPE='EMPTY-RPP-OR-RLB----'; OUTPUT; 00210000 EFLAG=3000; ETYPE='REVENUE-TOLERANCE---'; OUTPUT; 00210000 EFLAG=3100; ETYPE='WEIGHT-TOLERANCE----'; OUTPUT; 00210000 EFLAG=.; ETYPE='MISSING-EFLAG-VALUE-'; OUTPUT; 00210000 PROC SORT; BY EFLAG; 00210000 **************************************************************** * READ EDITDAT1 - VERIFY PARAMETERS - SPLIT INTO CLASS MODULES * ****************************************************************; DATA EDITDAT1; INFILE EDITDAT1; 00210000 INPUT @1 RUNTYPE $2. @3 CLASS $2. @5 SYS $6. @11 AP 2. @13 PQ 1. @14 FY 2. @16 RDATE 6. @22 FINNO 6. @28 VIP $5. @28 VIP1 $1. @29 VIP2 $1. @28 VIP12 $2. @30 VIP3 $1. @30 VIP34 $2. @31 VIP45 $2. @32 VIP5 $1. @29 VIP2345 $4. @28 VIP1234 $4. @33 RPWCODE 5. @38 R 12. /* @50-61 */ @62 P 12. @74 C 12. @86 W 14. @100 NRESP 1. /* MANUALS ONLY */ @101 MIGRATE 1. @102 EFLAG 4. /* @106 */ @107 STRATUM 3. @110 BLOWUP 8. @118 AIC 3. ; ************ * TEMP FIX * * AP2-00 FOR FINNO 518682; ************; IF FINNO=518682 & AP=2 & FY=00 THEN DO; IF VIP='04352' THEN DO; RHOLD=R; PHOLD=P; WHOLD=W; DELETE; END; IF VIP='04412' THEN DO; R=R+RHOLD; P=P+PHOLD; W=W+WHOLD; END; END; RETAIN RHOLD PHOLD WHOLD; DROP RHOLD PHOLD WHOLD; ************; * TEMP END *; ************; IF NRESP^=1 & (VIP=' ' OR VIP1=' ' OR VIP1='.') THEN ABORT; IF RUNTYPE^=&RUNTYPE THEN ABORT; IF PQ^=&PQ OR FY^=&FY THEN ABORT; IF &RUNTYPE='AP' & AP^=&AP THEN ABORT; 00210000 IF ^(10000<=FINNO<=599999) THEN ABORT; IF ^(RDATE=&RDATE1 OR RDATE=&RDATE2 OR RDATE=&RDATE3 OR RDATE=&RDATE4) & ^(VIP='44444' OR NRESP=1 OR EFLAG^=0) THEN ABORT; ***************** 00210000 * DUP REC CHECK * *DUPS OK IF EFLAG DIFFERS (=0050,0100); 00210000 *****************; 00210000 PROC SORT; 00210000 BY AP SYS CLASS AIC FINNO RDATE VIP DESCENDING EFLAG; 00210000 DATA _NULL_; SET EDITDAT1; 00210000 BY AP SYS CLASS AIC FINNO RDATE VIP DESCENDING EFLAG; 00210000 IF FIRST.VIP ^= LAST.VIP THEN DO; 00210000 IF FIRST.VIP THEN HOLDFLAG=EFLAG; 00210000 IF LAST.VIP & EFLAG=HOLDFLAG THEN ABORT; 00210000 END; 00210000 RETAIN HOLDFLAG; 00210000 **************************** 00210000 * SPLIT INTO CLASS MODULES * 00210000 ****************************; 00210000 DATA MOD0C MOD1C MODPD MODSA MODSB; SET EDITDAT1; 00210000 IF NRESP =1 OR 002 EFLAG ^=0 OR 002 VIP ='44444' THEN OUTPUT MOD0C; 002 ELSE IF CLASS =' ' THEN DO; 002 EFLAG=1000; OUTPUT MOD0C; 002 END; 002 ELSE IF CLASS='1C' THEN OUTPUT MOD1C; 002 ELSE IF CLASS='PD' THEN OUTPUT MODPD; 002 ELSE IF CLASS='SA' THEN OUTPUT MODSA; 002 ELSE IF CLASS='SB' THEN OUTPUT MODSB; 002 ELSE ABORT; 002 PROC DELETE DATA=EDITDAT1; 002 *********************************** * RPT R2-050: JOB-1 VERIFICATION * * FOR AUDITOR; ***********************************; DATA R050; SET MOD0C(IN=A) MOD1C MODPD MODSA MODSB; IF VIP^=' '; IF A=1 THEN RETAIN='N'; ELSE RETAIN='Y'; PROC SORT; BY SYS CLASS DESCENDING RETAIN STRATUM EFLAG AP; PROC SUMMARY; BY SYS CLASS DESCENDING RETAIN STRATUM EFLAG AP; ID BLOWUP; VAR R P W; OUTPUT OUT=R050A SUM=; PROC PRINT DATA=R050A; BY SYS CLASS DESCENDING RETAIN; PAGEBY SYS; ID RETAIN; VAR SYS CLASS STRATUM EFLAG AP R P W; SUM R P W; FORMAT R P W COMMA14.; TITLE1 "JOB2 ** RPW BULK MAIL SYSTEM ** FOR &RUNTYPE&AP PQ&PQ-&FY"; TITLE3 'R2-050A: JOB-1 OUTPUT VERIFICATION'; TITLE5 '(RETAIN=N DATA UNUSED DOWNSTREAM)'; TITLE7 'SUMMARY'; TITLE9 ' '; DATA R050B; SET R050; IF RETAIN='N'; PROC SORT; BY SYS CLASS STRATUM EFLAG RDATE VIP; PROC SUMMARY; BY SYS CLASS STRATUM EFLAG RDATE VIP; ID BLOWUP RETAIN; VAR R P W; OUTPUT OUT=R050B SUM=; PROC PRINT DATA=R050B; BY SYS CLASS; PAGEBY SYS; ID RETAIN; VAR SYS CLASS STRATUM BLOWUP EFLAG RDATE VIP R P W; SUM R P W; FORMAT R P W COMMA14.; TITLE3 'R2-050B: JOB-1 OUTPUT VERIFICATION'; TITLE5 '(RETAIN=N DATA UNUSED DOWNSTREAM)'; TITLE7 'DETAIL FOR RETAIN=N'; TITLE9 ' '; PROC DELETE DATA=R050; PROC DELETE DATA=R050S; PROC DELETE DATA=R050A; PROC DELETE DATA=R050B; ****************************** * RATE TABLES (VIP-RPW CODE) * ******************************; DATA RATES1C; INFILE RATES1C; LENGTH VIPCAT $48.; RTABLE='RATES1C'; INPUT @1 STAR $1. @; IF STAR='*' THEN DELETE; ELSE DO; INPUT @1 RDATE 6. @8 VIP $5. @9 VIP2345 $4. @8 VIP1 $1. @13 VIPX $1. @14 RPWCODE 5. @20 VIPCAT $27. @48 AIC 3. @52 RATEHI 7. @60 RATELO 7. @68 WPPMAX 9. @79 SYS $6. @89 ID $2. ; IF RDATE=. THEN ABORT; SPSERV=0; IF ID='SS' THEN SPSERV=1; IF RPWCODE>0 THEN DO; WPPMAX=WPPMAX/16; * CONVERT OZ TO LBS; IF WPPMAX<=0 OR RATEHI<=0 OR RATELO< 0 THEN ABORT; END; ******************************** * EXPAND MULTIPLE INDICIA VIPS * ********************************; IF VIPX=' ' THEN OUTPUT; /*OK AS IS*/ ELSE IF VIPX='+' THEN DO; VIP='1']]VIP2345; VIP1='1'; OUTPUT; *METERED; VIP='2']]VIP2345; VIP1='2'; OUTPUT; *STAMPED; END; END; DROP STAR VIPX; DATA RATESPD; INFILE RATESPD; RTABLE='RATESPD'; INPUT @1 STAR $1. @; IF STAR='*' THEN DELETE; ELSE DO; INPUT @1 RDATE 6. @8 VIP $5. @14 RPWCODE 5. @20 VIPCAT $48. @77 AIC 3. @81 PCRT 7. @89 LBRT 7. @97 WPPMAX 7. @105 SYS $6. @115 ID $2. ; IF RDATE=. THEN ABORT; IF ID='2D' THEN DISCOUNT='Y'; ELSE IF ID='2N' THEN DO; DISCOUNT='Y'; DISCNADV='Y'; END; ELSE IF ID='2I' THEN DO; DISCOUNT='Y'; FOREIGN='Y'; END; ELSE IF ID='2F' THEN FOREIGN='Y'; ELSE IF ID='2K' THEN KEYRATE ='Y'; ELSE IF ID='2S' THEN SCHARGE ='Y'; OUTPUT RATESPD; END; DROP STAR; DATA RATESSA; INFILE RATESSA; RTABLE='RATESSA'; INPUT @1 STAR $1. @; IF STAR='*' THEN DELETE; ELSE DO; INPUT @1 RDATE 6. @8 VIP $5. @9 VIP2345 $4. @8 VIP1 $1. @13 VIPX $1. @14 RPWCODE 5. @20 VIPCAT $42. @77 AIC 3. @81 PCRT 7. @89 LBRT 7. @97 WPPMIN 6. @104 WPPMAX 6. @111 SYS $6. @121 ID $2. @124 MVIP $5. ; IF RDATE=. THEN ABORT; SINGLE=0; PARTIAL=0; MULTI=0; IF ID='SP' THEN SINGLE =1; ELSE IF ID='PP' THEN PARTIAL=1; ELSE IF ID='MV' THEN MULTI=1; /*PIECE & POUND RATE PAIR*/ IF PCRT=. THEN PCRT=0; IF LBRT=. THEN LBRT=0; ******************************** * EXPAND MULTIPLE INDICIA VIPS * /* VIPS WITH VIP1=. */ ********************************; IF VIPX=' ' THEN OUTPUT; /*OK AS IS*/ ELSE IF VIPX='+' THEN DO; VIP='1']]VIP2345; VIP1='1'; OUTPUT; *METERED; VIP='2']]VIP2345; VIP1='2'; OUTPUT; *STAMPED; END; END; DROP STAR VIPX; DATA RATESSB; INFILE RATESSB; LENGTH VIPCAT $48.; RTABLE='RATESSB'; INPUT @1 STAR $1. @; IF STAR='*' THEN DELETE; ELSE DO; INPUT @1 RDATE 6. @8 VIP $5. @9 VIP2345 $4. @8 VIP1 $1. @13 VIPX $1. @14 RPWCODE 5. @20 VIPCAT $25. @52 RATEHI 7. /* PARCEL POST */ @60 RATELO 7. /* PARCEL POST */ @77 AIC 3. @81 PCRT 7. @89 LBRT 7. @97 WPPMIN 6. @104 WPPMAX 6. @111 SYS $6. @121 ID $2. @124 MVIP $5. ; IF RDATE=. THEN ABORT; SPSERV=0; SINGLE=0; MULTI=0; IF ID='DC' THEN DISCOUNT='Y'; ELSE IF ID='SS' THEN SPSERV=1; ELSE IF ID='SP' THEN SINGLE=1; /* NOTE: ALSO PC-RT M&PCS */ ELSE IF ID='MV' THEN MULTI=1; IF PCRT=. THEN PCRT=0; IF LBRT=. THEN LBRT=0; IF RATEHI=. THEN RATEHI=0; IF RATELO=. THEN RATELO=0; IF ABS(PCRT+LBRT)>0 THEN RHILO=0; ELSE RHILO=1; ******************************** * EXPAND MULTIPLE INDICIA VIPS * ********************************; IF VIPX=' ' THEN OUTPUT; /*OK AS IS*/ ELSE IF VIPX='+' THEN DO; VIP='1']]VIP2345; VIP1='1'; OUTPUT; *METERED; VIP='2']]VIP2345; VIP1='2'; OUTPUT; *STAMPED; END; END; DROP STAR VIPX; ********************************* * REPORT R2-100: EMPTY RPWCODE * *********************************; DATA RATESX; SET RATES1C RATESPD RATESSA RATESSB; IF RPWCODE=.; IF VIP^='44444'; PROC SORT; BY RTABLE RDATE VIP; PROC PRINT U; BY RTABLE RDATE; PAGEBY RDATE; VAR RDATE VIP VIPCAT; TITLE3 'R2-100: UNUSED R-TABLE ENTRIES (NO RPW CODE)'; TITLE5 ' '; PROC DELETE DATA=RATESX; ************************** * 1C MODULE: * **************************; PROC SORT DATA=MOD1C; BY RDATE VIP RPWCODE AIC; PROC SORT DATA=RATES1C; BY RDATE VIP RPWCODE AIC; DATA MOD1C RATE1CNU; MERGE MOD1C(IN=A) RATES1C(IN=B); BY RDATE VIP RPWCODE AIC; IF B=0 THEN EFLAG=1000; ELSE IF RPWCODE=. THEN EFLAG=1100; IF EFLAG=1100 OR A=0 THEN OUTPUT RATE1CNU; ELSE OUTPUT MOD1C; DATA MOD1C; SET MOD1C; RP=R; RW=0; IF EFLAG=0 THEN DO; IF SPSERV=1 THEN DO; IF P=0 OR P=. OR RP=0 OR RP=. THEN EFLAG=2000; END; ELSE DO; IF P=0 OR P=. OR W=0 OR W=. OR RP=0 OR RP=. THEN EFLAG=2000; END; DROP R; END; ********************** * RATIOS (VIP LEVEL) * **********************; RPP=0; RLB=0; IF P^=0 & P^=. THEN DO; RPP=RP/P; WPP=ABS(W/P); END; ************************************************** * EDITS (HIERARCHICAL): * * 1. MISSING DATA: 2. CLASS-LEVEL: 3. VIP-LEVEL. * **************************************************; IF EFLAG=0 THEN DO; IF RATEHI<=0 OR RATELO< 0 THEN EFLAG=1200; ELSE IF RPP=0 OR RPP=. THEN EFLAG=2500; ELSE IF ^((RATELO*(1-&RTOL)) <=RPP <=(RATEHI*(1+&RTOL))) THEN EFLAG=3000; ELSE IF WPP>=WPPMAX*(1+&WTOL) THEN EFLAG=3100; END; ***************** * ADD ETYPE VAR * *****************; PROC SORT DATA=MOD1C; BY EFLAG; DATA MOD1C; MERGE MOD1C(IN=A) ETYPE; BY EFLAG; IF A=1; PROC DELETE DATA=RATES1C; ************************** * PD MODULE: * **************************; PROC SORT DATA=MODPD; BY RDATE VIP RPWCODE AIC; PROC SORT DATA=RATESPD; BY RDATE VIP RPWCODE AIC; DATA MODPD RATEPDNU; MERGE MODPD(IN=A) RATESPD(IN=B); BY RDATE VIP RPWCODE AIC; IF B=0 THEN EFLAG=1000; ELSE IF RPWCODE=. THEN EFLAG=1100; IF EFLAG=1100 OR A=0 THEN OUTPUT RATEPDNU; ELSE OUTPUT MODPD; DATA MODPD; SET MODPD; RP=0; RW=0; ************** * ERROR FLAG * **************; IF EFLAG=0 THEN DO; IF SCHARGE ='Y' THEN DO; RP=R; PDISC=C; * RETAIN VOLUME FOR RATE CHECK SECTION; P=0; * ENSURE ZERO (NO DOUBLECOUNT); IF (RP=0 OR RP=.) OR (PDISC=0 OR PDISC=.) OR (W=0 OR W=.) THEN EFLAG=2000; ELSE IF P^=0 THEN EFLAG=2100; END; ELSE IF DISCOUNT='Y' & FOREIGN ^='Y' THEN DO; RP=-R; * NEEDED SINCE CBCIS PD DISC. NOT SIGNED; PDISC=P; * RETAIN VOL FOR RATE CHECK SECTION; P=0; * ZERO OUT PIECES (AVOID DOUBLECOUNT); IF RP=0 OR RP=. THEN EFLAG=2000; ELSE IF RP*PDISC ^<0 /* OPPOSITE SIGN CHECK */ OR P^=0 OR W^=0 THEN EFLAG=2100; END; ELSE IF DISCOUNT='Y' & FOREIGN ='Y' THEN DO; RW=-R; * NEEDED SINCE CBCIS PD DISC. NOT SIGNED; IF RW=0 OR RW=. OR W=0 OR W=. THEN EFLAG=2000; ELSE IF P^=0 OR C^=0 THEN EFLAG=2100; END; ELSE IF FOREIGN='Y' THEN DO; RW=R; P=C; /* COPIES = PIECES FOR PUB. PERIODICALS RATE */ IF RW=0 OR RW=. OR W=0 OR W=. OR P=0 OR P=. OR C=. THEN EFLAG=2000; END; ELSE IF KEYRATE='Y' THEN DO; RW=R; IF RW=0 OR RW=. OR W=0 OR W=. THEN EFLAG=2000; ELSE IF P^=0 THEN EFLAG=2100; END; ELSE IF (R=0 OR R=.) OR (P=0 OR P=.) & (W=0 OR W=.) THEN DO; RP=R; EFLAG=2000; END; ELSE IF P>0 & W>0 THEN DO; RP=R; EFLAG=2100; END; ELSE IF P^=0 & P^=. THEN RP=R; ELSE IF W^=0 & W^=. THEN RW=R; END; ELSE RP=R; * ALL OTHER CASES; DROP R; ************************** * ADD RATIOS (VIP LEVEL) * **************************; RPP=0; RLB=0; IF P^=0 & P^=. THEN CPP=ABS(C/P); IF FOREIGN='Y' & DISCOUNT='Y' & W^=0 & W^=. THEN RLB=RW/W; ELSE IF FOREIGN='Y' & W^=0 & W^=. THEN RLB=RW/W; ELSE IF DISCOUNT='Y' & ABS(PDISC) >0 THEN RPP=ABS(RP/PDISC); ELSE IF SCHARGE='Y' & ABS(PDISC) >0 THEN DO; RPP=ABS(RP/PDISC); WPP=ABS(W/PDISC); END; ELSE IF P^=0 & P^=. THEN RPP=RP/P; ELSE IF W^=0 & W^=. THEN RLB=RW/W; ******************************* * ADD RATIOS (RPW CODE LEVEL) * * NOT VIP LEVEL (FOR PD ONLY!); *******************************; * PASSED RECORDS ONLY USED!; PROC SORT DATA=MODPD; BY AP FINNO RPWCODE RDATE EFLAG; PROC SUMMARY DATA=MODPD; BY AP FINNO RPWCODE RDATE EFLAG; VAR C P W; OUTPUT OUT=WPPSUMPD SUM=CSUM PSUM WSUM; DATA WPPSUMPD; SET WPPSUMPD; IF EFLAG=0; DROP EFLAG; DATA MODPD; MERGE MODPD WPPSUMPD; BY AP FINNO RPWCODE RDATE; WPP=0; WPC=0; IF WSUM^=0 & PSUM^=0 THEN WPP=ABS(WSUM/PSUM); IF WSUM^=0 & CSUM^=0 THEN WPC=ABS(WSUM/CSUM); ************************************************* * EDITS (HIERARCHICAL): * * 1. MISSING DATA: 2. CLASS-LEVEL: 3. RPW LEVEL * *************************************************; DATA MODPD; SET MODPD; IF EFLAG=0 THEN DO; IF DISCOUNT='Y' & FOREIGN ^='Y' THEN DO; IF PCRT<=0 OR RPP=0 OR RPP=. OR DISCNADV ='Y' & ^(PCRT/100<=RPP<=PCRT*(1+&RTOL)) OR DISCNADV^='Y' & PCRT>0 & ABS(RPP-PCRT)/PCRT ^<=&RTOL THEN EFLAG=3000; END; ELSE IF DISCOUNT='Y' & FOREIGN='Y' THEN DO; IF ABS(RLB-LBRT)/LBRT ^<&RTOL THEN EFLAG=3000; END; ELSE IF FOREIGN='Y' THEN DO; IF ABS(RLB) >LBRT*(1-&RTOL) THEN EFLAG=3000; END; ELSE IF KEYRATE='Y' THEN DO; IF RLB >LBRT*(1+&RTOL) OR RLB<=0 THEN EFLAG=3000; END; ELSE IF PCRT<=0 & LBRT<=0 THEN EFLAG=1200; ELSE IF RPP+RLB=0 OR RPP+RLB=. THEN EFLAG=2500; /* ELSE IF WPP >WPPMAX*(1+&WTOL) OR WPC >WPPMAX*(1+&WTOL) THEN EFLAG=3100; */ ELSE IF PCRT>0 THEN DO; IF ABS(RPP-PCRT)/PCRT ^<&RTOL THEN EFLAG=3000; END; ELSE IF LBRT>0 THEN DO; IF ABS(RLB-LBRT)/LBRT ^<&RTOL THEN EFLAG=3000; END; END; ********; ********; ********; * TEMP *; ********; ********; IF RDATE=011099 & ('7'<=VIP1<='8') & EFLAG=3000 & ((RPP>PCRT) OR (DISCOUNT='Y' & ABS(RPP)>PCRT) OR (RLB>LBRT)) THEN DO; IF VIP34='11' & ABS(RLB/LBRT) <=1.03+&RTOL THEN EFLAG=0; ELSE IF VIP34='13' & ABS(RPP/PCRT) <=1.17+&RTOL THEN EFLAG=0; ELSE IF VIP34='14' & ABS(RPP/PCRT) <=1.23+&RTOL THEN EFLAG=0; ELSE IF VIP34='15' & ABS(RPP/PCRT) <=1.21+&RTOL THEN EFLAG=0; ELSE IF VIP34='16' & ABS(RPP/PCRT) <=1.22+&RTOL THEN EFLAG=0; ELSE IF VIP34='17' & ABS(RPP/PCRT) <=1.28+&RTOL THEN EFLAG=0; ELSE IF VIP34='18' & ABS(RPP/PCRT) <=1.16+&RTOL THEN EFLAG=0; ELSE IF VIP34='19' & ABS(RPP/PCRT) <=1.08+&RTOL THEN EFLAG=0; ELSE IF VIP34='20' & ABS(RPP/PCRT) <=1.10+&RTOL THEN EFLAG=0; ELSE IF VIP34='21' & ABS(RPP/PCRT) <=1.04+&RTOL THEN EFLAG=0; ELSE IF VIP34='22' & ABS(RPP/PCRT) <=1.08+&RTOL THEN EFLAG=0; ELSE IF VIP34='23' & ABS(RPP/PCRT) <=1.10+&RTOL THEN EFLAG=0; ELSE IF VIP34='24' & ABS(RPP/PCRT) <=1.12+&RTOL THEN EFLAG=0; ELSE IF VIP34='26' & ABS(RPP/PCRT) <=1.34+&RTOL THEN EFLAG=0; ELSE IF VIP34='27' & ABS(RPP/PCRT) <=1.86+&RTOL THEN EFLAG=0; ELSE IF VIP34='28' & ABS(RPP/PCRT) <=1.75+&RTOL THEN EFLAG=0; END; ******** * TEMP * * END; ********; ***************** * ADD ETYPE VAR * *****************; PROC SORT DATA=MODPD; BY EFLAG; DATA MODPD; MERGE MODPD(IN=A) ETYPE; BY EFLAG; IF A=1; PROC DELETE DATA=WPPSUMPD; PROC DELETE DATA=RATESPD; ************************** * SA MODULE: * **************************; PROC SORT DATA=MODSA; BY RDATE RPWCODE VIP AIC; PROC SORT DATA=RATESSA; BY RDATE RPWCODE VIP AIC; DATA MODSA RATESANU; MERGE MODSA(IN=A) RATESSA(IN=B); BY RDATE RPWCODE VIP AIC; IF B=0 THEN EFLAG=1000; ELSE IF RPWCODE=. THEN EFLAG=1100; IF EFLAG=1100 OR A=0 THEN OUTPUT RATESANU; ELSE OUTPUT MODSA; DATA MODSA; SET MODSA; RP=0; RW=0; *******************************************; *******************************************; *******************************************; IF SYS='M&PCS' & CLASS='SA' & LBRT ^=0 THEN W = (R - P*PCRT)/LBRT; ********* * EDITS * *********; IF EFLAG=0 THEN DO; IF MULTI=1 THEN DO; IF W^=0 & W^=. THEN RW=R; ELSE IF P^=0 & P^=. THEN RP=R; IF (RP=0 OR RP=.) & (RW=0 OR RW=.) & PCRT^=0 & LBRT^=0 OR (P=0 OR P=.) & (W=0 OR W=.) THEN DO; EFLAG=2000; RP=R; END; ELSE IF P^=0 & W^=0 THEN DO; EFLAG=2100; RP=R; END; END; ELSE DO; * ALL OTHER CASES; RP=PCRT*P; RW=R-RP; IF (RP=0 OR RP=.) OR (P=0 OR P=.) OR (W=0 OR W=.) THEN EFLAG=2000; END; END; ELSE RP=R; * ALL OTHER CASES; ******************************** * RPP & RLB RATIOS (VIP LEVEL) * ********************************; RPP=0; RLB=0; IF PARTIAL=0 THEN DO; /* NO RATIOS FOR PPI */ IF P^=0 & P^=. & W^=0 & W^=. THEN DO; RPP=RP/P; RLB=RW/W; END; ELSE IF P^=0 & P^=. THEN RPP=RP/P; ELSE IF W^=0 & W^=. THEN RLB=RW/W; END; DROP R; ********************************** * AUX W,P VARS FOR MVIP WPP CALC * **********************************; DATA MODSAM; SET MODSA; IF MULTI=1; PROC SORT; BY AP FINNO RDATE MVIP; PROC SUMMARY; BY AP FINNO RDATE MVIP; VAR P W; OUTPUT OUT=WPPMULTI SUM=MP MW; PROC SORT DATA=MODSA; BY AP FINNO RDATE MVIP; DATA MODSA; MERGE MODSA WPPMULTI; BY AP FINNO RDATE MVIP; IF MULTI=1 & (MP=0 OR MP=. OR MW=0 OR MW=.) THEN EFLAG=2000; ************* * WPP RATIO * *************; IF MULTI=0 & P^=0 & P^=. THEN WPP=ABS(W/P); ELSE IF MULTI=1 & MP^=0 THEN WPP=ABS(MW/MP); ************************************************** * EDITS (HIERARCHICAL): * * 1. MISSING DATA: 2. CLASS-LEVEL: 3. VIP-LEVEL. * **************************************************; IF EFLAG=0 THEN DO; * NOTE: BYPASS MULTI PCRT=0, UPDATE AS REQUIRED; IF MULTI^=1 & PCRT<=0 & LBRT<=0 THEN EFLAG=1200; ELSE IF MULTI^=1 & PARTIAL=0 & (RPP+RLB=0 OR RLB+RLB=.) THEN EFLAG=2500; ********************* * SINGLE PIECE ONLY * *********************; ELSE IF SINGLE=1 THEN DO; * NOTE: PCRT INCLUDES SURCHARGE, LBRT IS FOR UNIT OZ; OZPP=ROUND(0.4999 + WPP*16); *CHANGE TO UNIT OZ; IF RPP < (PCRT+OZPP*LBRT)*(1-&RTOL) OR RPP > (PCRT+OZPP*LBRT)*(1+&RTOL) THEN EFLAG=3000; END; ************* * ALL OTHER * *************; ELSE IF PARTIAL=0 & PCRT>0 & LBRT>0 THEN DO; IF ABS((PCRT*P+LBRT*W)-RP-RW)/(RP+RW)^<&RTOL THEN EFLAG=3000; END; ELSE IF PARTIAL=0 & PCRT>0 THEN DO; IF ABS(RPP-PCRT)/PCRT ^<&RTOL THEN EFLAG=3000; END; ELSE IF PARTIAL=0 & LBRT>0 THEN DO; IF ABS(RLB-LBRT)/LBRT ^<&RTOL THEN EFLAG=3000; END; ELSE IF PARTIAL=1 & RP^=0 THEN DO; IF ABS((PCRT*P+LBRT*W)-RP-RW)/(RP+RW)^<&RTOL THEN EFLAG=3000; END; IF ^(WPPMIN*(1-&WTOL) < WPP <=WPPMAX*(1+&WTOL)) THEN EFLAG=3100; END; ********************************* * SET EFLAG SAME FOR MVIP PAIRS * *********************************; PROC SORT; BY AP FINNO RDATE MVIP DESCENDING EFLAG; DATA MODSA; SET MODSA; BY AP FINNO RDATE MVIP; IF FIRST.MVIP THEN HIFLAG=EFLAG; IF MULTI=1 THEN EFLAG=HIFLAG; RETAIN HIFLAG; ***************** * ADD ETYPE VAR * *****************; PROC SORT DATA=MODSA; BY EFLAG; DATA MODSA; MERGE MODSA(IN=A) ETYPE; BY EFLAG; IF A=1; PROC DELETE DATA=MODSAM; PROC DELETE DATA=RATESSA; ************************** * SB MODULE: * **************************; PROC SORT DATA=MODSB; BY RDATE RPWCODE VIP AIC; PROC SORT DATA=RATESSB; BY RDATE RPWCODE VIP AIC; DATA MODSB RATESBNU; MERGE MODSB(IN=A) RATESSB(IN=B); BY RDATE RPWCODE VIP AIC; IF B=0 THEN EFLAG=1000; ELSE IF RPWCODE=. THEN EFLAG=1100; IF EFLAG=1100 OR A=0 THEN OUTPUT RATESBNU; ELSE OUTPUT MODSB; DATA MODSB; SET MODSB; RP=0; RW=0; *******************************************; *******************************************; *******************************************; IF SYS='M&PCS' & CLASS='SB' & VIP3='7' & LBRT ^=0 THEN DO; * DIV BY ZERO IF PC-RATE VIPS ; W = (R - P*PCRT)/LBRT; RW= W*LBRT; RP= P*PCRT; IF ABS(((RP+RW)-R)/R) >&RTOL THEN ABORT; END; ********* * EDITS * *********; IF EFLAG=0 THEN DO; IF DISCOUNT='Y' THEN DO; RP=R; * SB DISCOUNT IS SIGNED '-'; PDISC=P; * RETAIN VOL FOR RATE CHECK SECTION; P=0; * ZERO OUT PIECES (AVOID DOUBLECOUNT); IF RP=0 OR RP=. OR PDISC=0 OR PDISC=. THEN EFLAG=2000; ELSE IF RP*PDISC ^<0 /* ONE TERM MUST BE NEG */ OR W^=0 THEN EFLAG=2100; END; ELSE IF MULTI=1 THEN DO; IF W^=0 & W^=. THEN RW=R; ELSE IF P^=0 & P^=. THEN RP=R; IF (RP=0 OR RP=.) & (RW=0 OR RW=.) & PCRT^=0 & LBRT^=0 OR (P=0 OR P=.) & (W=0 OR W=.) THEN DO; EFLAG=2000; RP=R; END; ELSE IF P^=0 & W^=0 THEN DO; EFLAG=2100; RP=R; END; END; ELSE IF SPSERV=1 THEN DO; RP=R; IF (RP=0 OR RP=.) OR (P=0 OR P=.) THEN EFLAG=2000; END; ELSE DO; * ALL OTHER EFLAG=0 CASES; RP=R; IF (RP=0 OR RP=.) OR (P=0 OR P=.) OR (W=0 OR W=.) THEN EFLAG=2000; END; END; ELSE RP=R; * ALL OTHER CASES (NON-ZERO EFLAG); ******************************** * RPP & RLB RATIOS (VIP LEVEL) * ********************************; RPP=0; RLB=0; IF DISCOUNT='Y' & ABS(PDISC) >0 THEN RPP=ABS(RP/PDISC); ELSE IF P^=0 & P^=. THEN RPP=RP/P; ELSE IF W^=0 & W^=. THEN RLB=RW/W; DROP R; ********************************** * AUX W,P VARS FOR MVIP WPP CALC * **********************************; DATA MODSBM; SET MODSB; IF MULTI=1; PROC SORT; BY AP FINNO RDATE MVIP; PROC SUMMARY; BY AP FINNO RDATE MVIP; VAR P W; OUTPUT OUT=WPPMULTI SUM=MP MW; PROC SORT DATA=MODSB; BY AP FINNO RDATE MVIP; DATA MODSB; MERGE MODSB WPPMULTI; BY AP FINNO RDATE MVIP; IF MULTI=1 & (MP=0 OR MP=. OR MW=0 OR MW=.) THEN EFLAG=2000; ************* * WPP RATIO * *************; IF MULTI=0 & P^=0 & P^=. THEN WPP=ABS(W/P); ELSE IF MULTI=1 & MP^=0 & MP^=. THEN WPP=ABS(MW/MP); ************************************************** * EDITS (HIERARCHICAL): * * 1. MISSING DATA: 2. CLASS-LEVEL: 3. VIP-LEVEL. * **************************************************; IF EFLAG=0 THEN DO; * NOTE: BYPASS MULTI PCRT=0, UPDATE AS REQUIRED; IF MULTI=0 & (RHILO=0 & PCRT<=0 & LBRT<=0 OR RHILO=1 & RATEHI<=0 & RATELO< 0) THEN EFLAG=1200; ELSE IF MULTI=0 & (RPP+RLB=0 OR RLB+RLB=.) THEN EFLAG=2500; ***************** * DISCOUNT ONLY * *****************; IF DISCOUNT='Y' THEN DO; IF PCRT<=0 OR RPP=0 OR RPP=. OR ABS(RPP-PCRT)/PCRT ^<=&RTOL THEN EFLAG=3000; END; ********************************** * SINGLE PIECE (OR PC-RATE ONLY) * **********************************; ELSE IF SINGLE=1 THEN DO; IF (RHILO=0 & RPP<(PCRT+WPP*LBRT)*(1-&RTOL)) OR (RHILO=0 & RPP>(PCRT+WPP*LBRT)*(1+&RTOL)) OR (RHILO=1 & RPP< RATELO*(1-&RTOL)) OR (RHILO=1 & RPP> RATEHI*(1+&RTOL)) THEN EFLAG=3000; END; ************* * ALL OTHER * *************; ELSE IF PCRT>0 THEN DO; IF ABS(RPP-PCRT)/PCRT ^<&RTOL THEN EFLAG=3000; END; ELSE IF LBRT>0 THEN DO; IF ABS(RLB-LBRT)/LBRT ^<&RTOL THEN EFLAG=3000; END; ******* * ALL * *******; IF SPSERV ^=1 & DISCOUNT ^='Y' & ^(WPPMIN*(1-&WTOL) < WPP <=WPPMAX*(1+&WTOL)) THEN EFLAG=3100; END; ********************************* * SET EFLAG SAME FOR MVIP PAIRS * *********************************; PROC SORT; BY AP FINNO RDATE MVIP DESCENDING EFLAG; DATA MODSB; SET MODSB; BY AP FINNO RDATE MVIP; IF FIRST.MVIP THEN HIFLAG=EFLAG; IF MULTI=1 THEN EFLAG=HIFLAG; RETAIN HIFLAG; ***************** * ADD ETYPE VAR * *****************; PROC SORT DATA=MODSB; BY EFLAG; DATA MODSB; MERGE MODSB(IN=A) ETYPE; BY EFLAG; IF A=1; PROC DELETE DATA=RATESSB; PROC DELETE DATA=MODSBM; PROC DELETE DATA=ETYPE; *********** * COMBINE * ***********; DATA ERRS; SET MOD1C MODPD MODSA MODSB; ****************************** * REPORT R2-150: NEG VALUES * ******************************; DATA NEGVALUE; SET ERRS; IF DISCOUNT='Y' & (RP>0 OR PDISC<0 & PDISC^=.) OR DISCOUNT^='Y' & (RP<0 & RP^=. OR RW<0 & RW^=. OR P<0 & P^=. OR W<0 & W^=. OR C<0 & C^=.); PROC SORT; BY SYS CLASS EFLAG RDATE VIP; PROC SUMMARY; BY SYS CLASS EFLAG RDATE VIP; ID ETYPE; VAR RP RW C P PDISC W; OUTPUT OUT=NEGVALUE SUM=; * PROC PRINT; *BY SYS CLASS; * PAGEBY CLASS; * VAR EFLAG ETYPE RDATE VIP RP RW C P PDISC W; * SUM RP RW C P W; * TITLE3 'R2-150: NEGATIVE VALUES'; * TITLE5 '(FLAGGED AND UNFLAGGED - FOR REVIEW ONLY)'; * TITLE7 '(%RTOL=100*'&RTOL ' %WTOL=100*'&WTOL')'; * TITLE9 ' '; PROC DELETE DATA=NEGVALUE; *********************************** * REPORT R2-200: EFLAG * STRATUM * ***********************************; PROC SORT DATA=ERRS; BY SYS CLASS STRATUM EFLAG RDATE; PROC SUMMARY DATA=ERRS; BY SYS CLASS STRATUM EFLAG RDATE; ID ETYPE; VAR RP RW C P PDISC W; OUTPUT OUT=E200 SUM=; DATA E200; SET E200; IF P^=0 & P^=. THEN DO; RPP=RP/P; WPP=ABS(W/P); CPP=ABS(C/P); END; IF W^=0 & W^=. THEN RLB=RW/W; PROC PRINT; BY SYS CLASS STRATUM; PAGEBY CLASS; FORMAT RPP RLB WPP 6.3 CPP 5.2 RP RW W 10.; ID EFLAG; VAR ETYPE RDATE _FREQ_ RPP RLB WPP CPP RP RW P PDISC W; SUM _FREQ_ RP RW P W; * NOT PDISC (DBL CNT); TITLE3 'R2-200: EFLAG SUMMARY - EFLAG*STRATUM'; TITLE5 '(%RTOL=100*'&RTOL ' %WTOL=100*'&WTOL')'; TITLE7 ' '; PROC DELETE DATA=E200; ******************************* * REPORT R2-300: EFLAG * VIP * *******************************; PROC SORT DATA=ERRS; BY SYS CLASS EFLAG RDATE VIP; PROC SUMMARY DATA=ERRS; BY SYS CLASS EFLAG RDATE VIP; ID ETYPE RPWCODE RATELO RATEHI PCRT LBRT WPPMIN WPPMAX; VAR RP RW P PDISC C W; OUTPUT OUT=E300 SUM=; DATA E300; SET E300; IF P^=0 & P^=. THEN DO; RPP=RP/P; WPP=ABS(W/P); CPP=ABS(C/P); END; IF PDISC>0 THEN RPP=RP/PDISC; IF W^=0 & W^=. THEN RLB=RW/W; PROC PRINT; BY SYS CLASS EFLAG ETYPE; PAGEBY CLASS; FORMAT RPP RLB WPP 6.3 CPP 5.2 RP RW W 10.; ID RDATE; VAR VIP _FREQ_ PCRT LBRT RATELO RATEHI WPPMIN WPPMAX RPP RLB WPP CPP RP RW P PDISC W; SUMBY EFLAG; SUM _FREQ_ RP RW P W; * NOT PDISC; TITLE3 'R2-300: EFLAG SUMMARY - EFLAG * VIP'; TITLE5 '(%RTOL=100*'&RTOL ' %WTOL=100*'&WTOL')'; TITLE7 ' '; PROC DELETE DATA=E300; ************************************** * REPORT R2-400: EFLAG FINNO DETAIL * **************************************; DATA E400; SET ERRS; IF ^(EFLAG=0 OR EFLAG=1100); PROC SORT; BY SYS CLASS EFLAG RDATE VIP STRATUM FINNO AP; PROC PRINT; BY SYS CLASS EFLAG ETYPE RDATE; PAGEBY RDATE; FORMAT RPP RLB WPP WPC 6.3 CPP 5.2; FORMAT RPP RLB WPP WPC 6.3 CPP 5.2 RP RW W 10.; ID RDATE; VAR VIP STRATUM FINNO AP LBRT PCRT RATELO RATEHI WPPMIN WPPMAX RPP RLB WPP CPP WPC RP RW P PDISC W; SUMBY EFLAG; SUM RP RW P W; TITLE3 'R2-400: EFLAG SUMMARY - FINNO DETAIL'; TITLE5 '(%RTOL=100*'&RTOL ' %WTOL=100*'&WTOL')'; TITLE7 ' '; PROC DELETE DATA=E400; PROC DELETE DATA=ERRS; ************************************************* * COMBINE MODULES, UPDATE NONRESP, CALC F1 & F2 * *************************************************; DATA EDITDAT2; SET MOD0C(IN=A) MOD1C MODPD MODSA MODSB; IF A=1 THEN DO; RW=0; RP=0; IF W>0 & P<=0 THEN RW=R; ELSE RP=R; END; KEEP RUNTYPE CLASS SYS AP PQ FY FINNO VIP VIP1 VIP2345 RPWCODE RP RW P C W NRESP MIGRATE EFLAG STRATUM BLOWUP AIC RDATE DISCOUNT PDISC VIPCAT; PROC DELETE DATA=MOD0C; PROC DELETE DATA=MOD1C; PROC DELETE DATA=MODPD; PROC DELETE DATA=MODSA; PROC DELETE DATA=MODSB; *********************************************** * UPDATE NRESP IF ALL RECS FAIL (MNUALS ONLY) * /* BY AP */ ***********************************************; DATA NRESPX; SET EDITDAT2; IF STRATUM>=2.0; PROC SORT DATA=NRESPX; BY SYS AP FINNO; DATA NRESPX; SET NRESPX; BY SYS AP FINNO; IF NRESP=0 & EFLAG=0 THEN PASS=1; IF LAST.FINNO AND PASS^=1; *ALL RECS FAILED; RETAIN PASS; KEEP AP SYS FINNO; PROC SORT DATA=EDITDAT2; BY SYS AP FINNO; DATA EDITDAT2; MERGE EDITDAT2 NRESPX(IN=B); BY SYS AP FINNO; IF B=1 THEN NRESP=1; * CHANGED FROM 0 IF ALL RECS FAILED; *********************************** * COUNT APS WITH >=1 PASSING RECS * ***********************************; * CBCIS OFFICES; PROC DELETE DATA=NRESPX; DATA F1KOUNT1; SET EDITDAT2; IF STRATUM<2.0 & EFLAG=0; PROC SORT DATA=F1KOUNT1; BY FINNO AP; DATA F1KOUNT1; SET F1KOUNT1; BY FINNO AP; IF FIRST.FINNO THEN KAP1=0; IF FIRST.AP AND NRESP=0 THEN KAP1=KAP1+1; IF LAST.FINNO; RETAIN KAP1; KEEP FINNO KAP1; * MANUAL OFFICES; DATA F1KOUNT2; SET EDITDAT2; IF STRATUM>=2.0 & EFLAG=0; PROC SORT DATA=F1KOUNT2; BY SYS FINNO AP; DATA F1KOUNT2; SET F1KOUNT2; BY SYS FINNO AP; IF FIRST.FINNO THEN KAP2=0; IF FIRST.AP AND NRESP=0 THEN KAP2=KAP2+1; IF LAST.FINNO; RETAIN KAP2; KEEP SYS FINNO KAP2; PROC SORT DATA=EDITDAT2; BY SYS FINNO; DATA EDITDAT2; MERGE EDITDAT2 F1KOUNT2; BY SYS FINNO; PROC SORT DATA=EDITDAT2; BY FINNO; DATA EDITDAT2; MERGE EDITDAT2 F1KOUNT1; BY FINNO; *********** * CALC F1 * * NOTE: F1=. (N/A) IF NRESP=1 ; ***********; IF &RUNTYPE='AP' THEN F1=1; ELSE DO; NAP=3; IF &PQ=4 THEN NAP=4; *NUMBER OF APS IN PQ; IF STRATUM <2.0 & KAP1 ^=0 THEN F1=NAP/KAP1; IF STRATUM >=2.0 & KAP2 ^=0 THEN F1=NAP/KAP2; END; PROC DELETE DATA=F1KOUNT1; *********** * CALC F2 * ***********; PROC SORT DATA=EDITDAT2; BY SYS STRATUM FINNO; DATA F2KOUNT2; SET EDITDAT2; BY SYS STRATUM FINNO; IF STRATUM>=2.0; IF FIRST.STRATUM THEN DO; NHSAMP=0; KNRESP=0; END; IF FIRST.FINNO THEN DO; NHSAMP=NHSAMP+1; IF KAP2=0 OR KAP2=. THEN KNRESP=KNRESP+1; END; IF LAST.STRATUM; RETAIN NHSAMP KNRESP; KEEP SYS STRATUM NHSAMP KNRESP; DATA EDITDAT2; MERGE EDITDAT2 F2KOUNT2; BY SYS STRATUM; IF STRATUM <2.0 THEN F2=1; ELSE IF NHSAMP>KNRESP THEN F2=NHSAMP/(NHSAMP-KNRESP); ELSE F2=0; /* STRATUM EMPTY: MANUAL INTERVENTION */ PROC DELETE DATA=F2KOUNT2; **************** * F1-F2 REPORT * * FOR AUDITOR; ****************; * NOTE: LOERR=0 CONFIRMS AT LEAST 1 PASSING RECORD; PROC SORT DATA=EDITDAT2; BY SYS STRATUM FINNO EFLAG; DATA FCHECK;SET EDITDAT2; BY SYS STRATUM FINNO EFLAG; IF SYS^=' '; ZVOL=RP+RW+P+W; IF FIRST.FINNO THEN LOERR=EFLAG; RETAIN LOERR; KEEP SYS STRATUM FINNO F1 F2 NRESP NHSAMP KNRESP ZVOL LOERR; PROC SUMMARY; BY SYS STRATUM FINNO; ID F1 F2 NRESP NHSAMP KNRESP LOERR; VAR ZVOL; OUTPUT OUT=FCHECK SUM=; DATA FCHECK; SET FCHECK; X=1; IF ABS(ZVOL)=0 THEN ZERO='Y'; IF STRATUM >1 OR F1 ^=1 OR F2 ^=1 OR LOERR^=0 THEN XFINNO=FINNO; ELSE IF ZERO='Y' THEN XFINNO=888888; ELSE XFINNO=999999; PROC SORT; BY SYS STRATUM XFINNO; PROC SUMMARY; BY SYS STRATUM XFINNO; ID F1 F2 NHSAMP KNRESP ZERO NRESP LOERR; VAR X; OUTPUT OUT=FCHECK SUM=; PROC SORT; BY SYS STRATUM ZERO F1 F2; PROC PRINT; BY SYS; VAR SYS STRATUM XFINNO _FREQ_ ZERO F1 F2 LOERR NRESP NHSAMP KNRESP; FORMAT F1 F2 7.4 NHSAMP KNRESP _FREQ_ COMMA13.; TITLE3 'R2-500: F1, F2 FACTORS'; TITLE4 'AND 0-VOL & 100% FAIL SITES'; TITLE5 '(DUMMY FIN= 888888,999999)'; TITLE6 ' '; PROC DELETE DATA=FCHECK; ********************** * COLLECT 0-VOL VIPS * /* DUMMY FINNO=0, ASIGN TO STRATUM-1 */ **********************; DATA ZEROVIPS R600; SET RATE1CNU(IN=A) RATEPDNU(IN=B) RATESANU(IN=C) RATESBNU(IN=D); IF A=1 THEN CLASS='1C'; ELSE IF B=1 THEN CLASS='PD'; ELSE IF C=1 THEN CLASS='SA'; ELSE IF D=1 THEN CLASS='SB'; AP=&AP; PQ=&PQ; FY=&FY; X=1; RUNTYPE=&RUNTYPE; FINNO=0; STRATUM=1; F1=1; F2=1; BLOWUP=1; RP=0; RW=0; P=0; C=0; W=0; IF EFLAG=. THEN EFLAG=0; NRESP=0; OUTPUT ZEROVIPS; ********** * FILTER * **********; IF RDATE=&RDATE1; OUTPUT R600; PROC DELETE DATA=RATE1CNU; PROC DELETE DATA=RATEPDNU; PROC DELETE DATA=RATESANU; PROC DELETE DATA=RATESBNU; ********************** * PRINT UNUSED CODES * * MOST RECENT RATE DATE ONLY; **********************; PROC SORT DATA=R600; BY SYS EFLAG RDATE VIP; PROC SUMMARY DATA=R600; BY SYS EFLAG RDATE VIP; ID VIPCAT RPWCODE PCRT LBRT RATELO RATEHI WPPMIN WPPMAX; VAR X; OUTPUT OUT=R600 SUM=; PROC SORT DATA=R600; BY DESCENDING EFLAG SYS RDATE; PROC PRINT DATA=R600 U; BY DESCENDING EFLAG SYS RDATE; PAGEBY SYS; ID VIP; VAR VIPCAT RPWCODE PCRT LBRT RATELO RATEHI WPPMIN WPPMAX; TITLE3 'R2-600: UNUSED VIP CODES'; TITLE4 'FOR RATEDATE ' &RDATE1 ' ONLY (BY SYSTEM)'; TITLE6 'NOTE: INCLUDES EFLAG=1100'; TITLE7 ' '; PROC DELETE DATA=R600; **************************** * ADD ZERO RECORDS, OUTPUT * ****************************; DATA EDITDAT2; SET EDITDAT2 ZEROVIPS; PROC DELETE DATA=ZEROVIPS; PROC SORT; BY FINNO VIP AP; DATA _NULL_; SET EDITDAT2; ************************** * OVERWRITE P WITH PDISC * /* FOR PERIODICALS */ **************************; IF DISCOUNT='Y' THEN P=PDISC; FILE EDITDAT2; PUT @1 RUNTYPE $2. @3 CLASS $2. @5 SYS $6. @11 AP Z2. @13 PQ 1. @14 FY 2. @16 RDATE Z6. @22 FINNO Z6. @28 VIP $5. @33 RPWCODE Z5. @38 RP Z12.2 @50 RW Z12.2 @62 P Z12. @74 C Z12. @86 W Z14.2 @100 NRESP 1. @101 MIGRATE 1. @102 EFLAG Z4. @106 DISCOUNT $1. @107 STRATUM Z3.1 @110 BLOWUP Z8.3 @118 AIC 3. @121 F1 Z10.8 @131 F2 Z15.8 ; ******************** * PRINT RPW TOTALS * ********************; DATA PASS; SET EDITDAT2; IF ^(VIP='44444' OR NRESP=1) & EFLAG=0; IF RPWCODE^=.; PROC SORT DATA=PASS; BY SYS AIC CLASS STRATUM RPWCODE; PROC SUMMARY DATA=PASS; BY SYS AIC CLASS STRATUM RPWCODE; VAR RP RW P C W; OUTPUT OUT=PASS SUM=; PROC DELETE DATA=EDITDAT2; PROC PRINT DATA=PASS; BY SYS AIC CLASS; PAGEBY CLASS; FORMAT RP RW W COMMA15.2 P C COMMA13. STRATUM 3.1; ID SYS; VAR AIC CLASS STRATUM RPWCODE RP RW P C W; SUM RP RW P C W; TITLE3 'R2-800: UNINFLATED RPW: STRATUM * RPWCODE'; TITLE5 'PASSED RECORDS'; TITLE6 ' '; /*