Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ADEFPC1

ADEFPC1.m

Go to the documentation of this file. 
  1. ADEFPC1 ; IHS/HQT/MJL  - F- COMPLIANCE PART 2 ;07:54 PM  [ 03/24/1999   9:04 AM ]
  1.  ;;6.0;ADE;;APRIL 1999
  1.  ;
  1.  S ADEOPT=$P(ADEWSNOD,"^",5) S ADEOPT=$S(ADEOPT="A":1.2,ADEOPT="B":1.1,ADEOPT="D":.9,ADEOPT="E":.8,ADEOPT="F":.7,1:1)
  1.  S ADENAT=$P(ADEWSNOD,"^",4)
  1.  S ADEPOP=$P(ADEWSNOD,"^",7)
  1.  ;
  1.  S (ADETDAY,ADETPPM,ADETCNT,ADELAT,ADEABS,ADESTOP)=0
  1.  S ADEBM=$E(ADEBD,1,5),ADEEM=$E(ADEED,1,5)
  1.  ;
  1.  S ADEABS=$O(^ADEFLU(ADEFLDFN,1,"AB",ADEABS)),ADEABSMO=$E(ADEABS,1,5) Q:ADEABS=""
  1. CONTROL ;------->INCREMENT FOR EACH MONTH IN REPORT
  1.  F ADECUR=ADEBM:1 S:$E(ADECUR,4,5)=13 ADECUR=ADECUR+88 Q:ADECUR>ADEEM  D LENGTH,CURMO,SYSET,SUSET,ARSET^ADEFPC3
  1.  ;------->SET SYSTEM TOTAL FOR ENTIRE DATE RANGE
  1.  D SYSTOT^ADEFPC3
  1. END Q
  1.  ;
  1.  ;
  1. CURMO ;------->PROCESS CURRENT MONTH ADECUR
  1.  S (ADEQ,ADEMPPM,ADEMCNT)=0
  1.  I ADESTOP S ADEMCNT=0,ADEINC=ADECML,ADEMPPM=ADECPPM*ADEINC Q
  1.  I ADECUR<ADEABSMO S ADEMCNT=0,ADEMPPM=0 Q
  1.  I ADECUR=ADEABSMO S ADELAT=ADEABS,ADEMCNT=1
  1.  I '+ADELAT D LATEST
  1.  S ADEQ=0 F ADEK=0:0 S ADENEX=$O(^ADEFLU(ADEFLDFN,1,"AB",ADELAT)),ADENEXMO=$E(ADENEX,1,5) D PPM,MONTH Q:ADEQ
  1.  S:ADECUR=ADEABSMO ADECML=ADECML-$E(ADEABS,6,7) S:ADECML=0 ADECML=1
  1.  Q
  1. LATEST ;------->RETURNS DATE OF LATEST ENTRY BEFORE FIRST MONTH OF PROCESSING
  1.  S ADELAT=ADEABS F ADEJ=0:0 S ADETST=$O(^ADEFLU(ADEFLDFN,1,"AB",ADELAT)) Q:ADETST=""  S:$E(ADETST,1,5)<ADECUR ADELAT=ADETST Q:ADELAT'=ADETST
  1.  Q
  1. PPM ;------->RETURNS ADECPPM FOR ENTRY DATED ADELAT
  1.  S ADEX=$O(^ADEFLU(ADEFLDFN,1,"AB",ADELAT,0)),ADECPPM=$P(^ADEFLU(ADEFLDFN,1,ADEX,0),U,2) Q
  1. MONTH ;------->STEP THROUGH CURRENT MONTH ENTRIES AND CALCULATE
  1.  ;---NEXT IN CURRENT MONTH, PREVIOUS ENTRY IN PREVIOUS MONTH
  1.  I ADENEXMO=ADECUR,$E(ADELAT,1,5)<ADECUR S ADEINC=ADENEX-(ADECUR_"00"),ADEMPPM=ADEMPPM+(ADEINC*ADECPPM),ADELAT=ADENEX,ADEMCNT=ADEMCNT+1 Q
  1.  ;---NEXT AND PREVIOUS ENTRIES WITHIN THE CURRENT MONTH
  1.  I ADENEXMO=ADECUR S ADEINC=ADENEX-ADELAT,ADEMPPM=ADEMPPM+(ADEINC*ADECPPM),ADELAT=ADENEX,ADEMCNT=ADEMCNT+1 D PPM Q
  1.  ;---NEXT ENTRY IS GREATER THAN CURRENT MONTH
  1.  I ADENEXMO>ADECUR S ADEINC=$S($E(ADELAT,1,5)<ADECUR:ADECML,1:(ADECUR_ADECML)-ADELAT) S:ADEINC=0 ADEINC=1 S ADEMPPM=ADEMPPM+(ADEINC*ADECPPM),ADEQ=1 Q
  1.  ;---NEXT ENTRY IS NULL, PREVIOUS ENTRY IN PREVIOUS MONTH
  1.  I ADENEXMO="",$E(ADELAT,1,5)<ADECUR S ADEINC=ADECML,ADEMPPM=ADEMPPM+(ADEINC*ADECPPM),ADEQ=1,ADESTOP=1 Q
  1.  ;---NEXT ENTRY NULL, PREVIOUS ENTRY IN CURRENT MONTH
  1.  I ADENEXMO="" S ADEINC=ADECML-$E(ADELAT,6,7),ADEMPPM=ADEMPPM+(ADEINC*ADECPPM),ADEQ=1,ADESTOP=1 Q
  1.  Q
  1. SYSET ;------->SET WATER SYS MONTHLY NODE
  1.  ;          FORMAT "SAMPLE COUNT^WTD AVG^IN RANGE^IN COMP"
  1.  ; ^TMP is transient, non-fileman working global
  1.  S ADETPPM=ADETPPM+ADEMPPM,ADETCNT=ADETCNT+ADEMCNT
  1.  S ^TMP("ADEFPC",ADEU,ADEAREA,ADESU,ADEWSNAM,ADECUR)=ADEMCNT_"^"_$J((ADEMPPM/ADECML),4,1)
  1.  I ($J((ADEMPPM/ADECML),3,1)<(ADEOPT-.1))!((ADEMPPM/ADECML)>(ADEOPT+.5)) D
  1.  . S $P(^TMP("ADEFPC",ADEU,ADEAREA,ADESU,ADEWSNAM,ADECUR),"^",3)="N"
  1.  E  S $P(^TMP("ADEFPC",ADEU,ADEAREA,ADESU,ADEWSNAM,ADECUR),"^",3)="Y"
  1.  I $P(^TMP("ADEFPC",ADEU,ADEAREA,ADESU,ADEWSNAM,ADECUR),"^",1)=0 D
  1.  . S $P(^TMP("ADEFPC",ADEU,ADEAREA,ADESU,ADEWSNAM,ADECUR),"^",3)=$P(^TMP("ADEFPC",ADEU,ADEAREA,ADESU,ADEWSNAM,ADECUR),"^",3)_"-"
  1.  I $P(^TMP("ADEFPC",ADEU,ADEAREA,ADESU,ADEWSNAM,ADECUR),U)>(ADECOMP-1),$P(^TMP("ADEFPC",ADEU,ADEAREA,ADESU,ADEWSNAM,ADECUR),U,3)="Y" D
  1.  . S $P(^TMP("ADEFPC",ADEU,ADEAREA,ADESU,ADEWSNAM,ADECUR),U,4)="Y"
  1.  E  S $P(^TMP("ADEFPC",ADEU,ADEAREA,ADESU,ADEWSNAM,ADECUR),U,4)="N"
  1.  Q
  1. SUSET ;------->SET SU MONTHLY NODE
  1.  ;FORMAT: "IN RANGE^OUT OF RANGE^IN COMP^OUT COMP^NO SAMPL^POP IN COMP"
  1.  ;
  1.  I '$D(^TMP("ADEFPC",ADEU,ADEAREA,ADESU,"MO",ADECUR)) D
  1.  . S ^TMP("ADEFPC",ADEU,ADEAREA,ADESU,"MO",ADECUR)="0^0^0^0^0^0"
  1.  I $P(^TMP("ADEFPC",ADEU,ADEAREA,ADESU,ADEWSNAM,ADECUR),"^",3)["Y" D
  1.  . S $P(^TMP("ADEFPC",ADEU,ADEAREA,ADESU,"MO",ADECUR),"^")=$P(^TMP("ADEFPC",ADEU,ADEAREA,ADESU,"MO",ADECUR),"^")+1
  1.  E  S $P(^TMP("ADEFPC",ADEU,ADEAREA,ADESU,"MO",ADECUR),"^",2)=$P(^TMP("ADEFPC",ADEU,ADEAREA,ADESU,"MO",ADECUR),"^",2)+1
  1.  I $P(^TMP("ADEFPC",ADEU,ADEAREA,ADESU,ADEWSNAM,ADECUR),U,4)="Y" D
  1.  . S $P(^TMP("ADEFPC",ADEU,ADEAREA,ADESU,"MO",ADECUR),U,3)=$P(^TMP("ADEFPC",ADEU,ADEAREA,ADESU,"MO",ADECUR),U,3)+1
  1.  . S $P(^TMP("ADEFPC",ADEU,ADEAREA,ADESU,"MO",ADECUR),U,6)=$P(^TMP("ADEFPC",ADEU,ADEAREA,ADESU,"MO",ADECUR),U,6)+ADEPOP
  1.  E  S $P(^TMP("ADEFPC",ADEU,ADEAREA,ADESU,"MO",ADECUR),U,4)=$P(^TMP("ADEFPC",ADEU,ADEAREA,ADESU,"MO",ADECUR),U,4)+1
  1.  I $P(^TMP("ADEFPC",ADEU,ADEAREA,ADESU,ADEWSNAM,ADECUR),U)=0 D
  1.  . S $P(^TMP("ADEFPC",ADEU,ADEAREA,ADESU,"MO",ADECUR),U,5)=$P(^TMP("ADEFPC",ADEU,ADEAREA,ADESU,"MO",ADECUR),U,5)+1
  1.  Q
  1.  ;
  1. LENGTH ;EP - RETURNS LENGTH OF CURRENT MONTH
  1.  ;beginning Y2K fix
  1.  ;S ADECML=$E(ADECUR,4,5),ADECML=$S((ADECML="09")!(ADECML="04")!(ADECML="06")!(ADECML="11"):30,ADECML="02":$S($E(ADECUR,2,3)=88:29,1:28),1:31)
  1.  S ADECML=$E(ADECUR,4,5),ADECY=$E(ADECUR,1,3)+1700,ADELYFLG=$$LEAP^XBDT(ADECY) ;Y2000
  1.  F ADEI=1:1:12 D  ;Y2000
  1.  .S ADEML(ADEI)=31 ;Y2000
  1.  .S:ADEI=2 ADEML(ADEI)=$S(ADELYFLG:29,1:28) ;Y2000
  1.  .S ADECK=","_ADEI_"," ;Y2000
  1.  .S:(",4,6,9,11,"[ADECK) ADEML(ADEI)=30 ;Y2000
  1.  S ADECML=ADEML(+ADECML) ;Y2000
  1.  K ADEML,ADEI,ADECY,ADELYFLG,ADECK  ;Y2000
  1.  ;end Y2K fix block
  1.  Q