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

ADEFPC.m

Go to the documentation of this file. 
  1. ADEFPC ; IHS/HQT/MJL - F COMPLIANCE PT 1 ;05:11 PM  [ 03/24/1999   9:04 AM ]
  1.  ;;6.0;ADE;;APRIL 1999
  1.  ;
  1.  D ^XBKVAR I '$D(DUZ(2)) W !,"DIVISION NOT SET IN USER FILE -- CONTACT SITE MANAGER OR ISC" Q
  1.  I DUZ(2)=0 W !,"DIVISION SET TO ZERO (UNIVERSAL). DIVISION MUST BE SET TO ONE OF THE ",!,"SITES IN THE DENTAL SITE PARAMETER FILE. -- CONTACT SITE MANAGER" Q
  1.  ;
  1. PRE D ^ADECLS
  1.  S ADEXX="Compliance Summary By Water System"
  1.  W $J("",(80-$L(ADEXX))\2)_ADEXX,!,!
  1.  N ADEROPT
  1.  S ADECOMP=$S($D(^ADEPARAM(DUZ(2),0)):+$P(^ADEPARAM(DUZ(2),0),U,7),1:1) S:'ADECOMP ADECOMP=1
  1. DATE ;GET DATE RANGE
  1.  S U="^",%DT="AE",%DT(0)=-DT,%DT("A")="SELECT BEGINNING MONTH-YEAR: " D ^%DT K %DT
  1.  G:Y<0 END S ADEBD=Y,%DT="AE",%DT(0)=ADEBD,%DT("A")="SELECT ENDING MONTH-YEAR: " D ^%DT K %DT
  1.  G:X="^" DATE G:Y<0 END S ADEED=Y I ADEED>DT W " ??",*7 G DATE
  1.  ;
  1. ROPT ;GET REPORT OPTIONS
  1.  W !
  1.  S ADEROPT=$$REP^ADEFPC4()
  1.  I $$HAT^ADEPQA() W ! G DATE
  1.  I ADEROPT="" W !!,"No reports selected."  G END
  1.  W !!
  1.  I ADEROPT[1 W "AREA" W:$L(ADEROPT)>2 ", "
  1.  I ADEROPT[2 W:ADEROPT=12 " and " W "SERVICE UNIT"
  1.  I ADEROPT[3 W:$L(ADEROPT)>1 " and " W "WATER SYSTEM"
  1.  W " Report" W:$L(ADEROPT)>1 "s" W " will be printed.",!
  1.  ;
  1.  S ADEU=$$ADEU()
  1.  K ^TMP("ADEFPC",ADEU)
  1.  ;^TMP is a transient, non-fileman working global.
  1.  S ^TMP("ADEFPC",ADEU)="RUNNING"
  1.  ;W !!,"JOB ",$J,": ADEU=",ADEU R !!,AZZ ;***COMMENT & KEEP
  1.  D ASKDEV
  1.  I POP K ^TMP("ADEFPC",ADEU) G END
  1.  ;FHL 9/9/98 I $D(ZTSK) G END
  1.  I $D(ZTQUEUED) G END
  1.  ;
  1. ZTM ;EP TASKMAN ENTRY FOR PROCESSING PHASE
  1.  I $D(ZTQUEUED) L +^TMP("ADEFPC",ADEU):1 I '$T S ZTREQ="@" G END
  1.  S ADEJ=($E(ADEED,1,3)-$E(ADEBD,1,3)+1)*12-($E(ADEBD,4,5)-1)-($E(ADEED,1,3)_"12"-$E(ADEED,1,5))
  1.  S ^TMP("ADEFPC",ADEU)=ADEBD_U_ADEED_U_DT_U_ADEJ
  1.  S ADEWSDFN=0
  1.  F  S ADEWSDFN=$O(^ADEWS(ADEWSDFN)) Q:'+ADEWSDFN  D
  1.  . S ADEWSNOD=^ADEWS(ADEWSDFN,0)
  1.  . S ADEWSNAM=$P(ADEWSNOD,"^",2)_"-"_$P(ADEWSNOD,"^")
  1.  . I $P(ADEWSNOD,U,8)="y" Q
  1.  . S ADECOMM=$P(ADEWSNOD,"^",6) Q:ADECOMM']""
  1.  . S ADECOMM=^AUTTCOM(ADECOMM,0)
  1.  . S ADESU=$P(ADECOMM,"^",5) Q:ADESU']""
  1.  . S ADESU=^AUTTSU(ADESU,0)
  1.  . S ADESUNAM=$P(ADESU,U)
  1.  . S ADESU=$P(ADESU,U,4) Q:ADESU']""
  1.  . S ADEAREA=$P(ADECOMM,"^",6) Q:'ADEAREA
  1.  . S ADEAREA=^AUTTAREA(ADEAREA,0)
  1.  . S ADEARNAM=$P(ADEAREA,U)
  1.  . S ADEAREA=$P(ADEAREA,U,2) Q:ADEAREA']""
  1.  . Q:'$D(^ADEFLU("B",ADEWSDFN))
  1.  . S ADEFLDFN=$O(^ADEFLU("B",ADEWSDFN,0))
  1.  . D ^ADEFPC1
  1.  D PCOMP^ADEFPC3
  1.  I $O(^TMP("ADEFPC",ADEU,0))="" G END
  1.  ;
  1.  I $D(ZTQUEUED) D  G END
  1.  . I $D(IOT),IOT'="HFS" D  Q
  1.  . . S ZTREQ=$H_U_ADEIOP_U_"FLUORIDE COMPLIANCE REPORT"_U_"PRINT^ADEFPC"
  1.  . D PRINT Q
  1.  I '$D(ZTQUEUED) D PRINT
  1.  ;
  1.  ;
  1. END I $D(ADEU) L -^TMP("ADEFPC",ADEU)
  1.  K ADEABS,ADEABSMO,ADEBD,ADEBM,ADEBSU,ADECML,ADECOMM,ADECOMP,ADECPPM,ADECUR,ADEDEF,ADEED,ADEEM,ADEESU,ADEFLDFN,ADEINC
  1.  K ADEJ,ADEK,ADELAT,ADELIN,ADEMCNT,ADEMOCNT,ADEMPPM,ADENAT,ADENEX,ADENEXMO,ADEOPT,ADEPAG,ADEPOP,ADEQ,ADEQIT,ADESHORT,ADESL
  1.  K ADESTOP,ADESU,ADESUCNT,ADESYS,ADESYCNT,ADETCNT,ADETDAY,ADETPPM,ADETST,ADEWSDFN,ADEWSNAM,ADEWSNOD,ADEXX,ADEX,ADEYM
  1.  K ADEIOP,ADEU,ADEAREA,ADETMON,ADESUNAM,ADEARNAM,ADEMO
  1.  K ADED0,ADED1,ADED2,ADED3,ADEZTSK,ADEIOPAR
  1.  K ADENOD,ADEROPT
  1.  Q
  1.  ;
  1. PRINT ;EP TASKMAN ENTRY FOR PRINT PHASE
  1.  I '$D(^TMP("ADEFPC",ADEU)) G PRNEND
  1.  I '+$O(^TMP("ADEFPC",ADEU,0)) G PRNEND
  1.  I $D(ZTQUEUED) L +^TMP("ADEFPC",ADEU):1 I '$T S ADENOLOK=1 G PRNEND
  1.  N FLDS
  1.  F FLDS="[ADEP-ADEFPC-AREA]","[ADEP-ADEFPC-SU]","[ADEP-ADEFPC-SYS2]" D
  1.  . Q:FLDS["AREA"&(ADEROPT'["1")
  1.  . Q:FLDS["SU"&(ADEROPT'["2")
  1.  . Q:FLDS["SYS"&(ADEROPT'["3")
  1.  . N DIC,BY,ADED0,ADED1,ADED2,ADED3,DHD,Y
  1.  . S IOP=ADEIOP
  1.  . S %ZIS("IOPAR")=ADEIOPAR
  1.  . D ^%ZIS
  1.  . S IOP=ADEIOP
  1.  . S %ZIS("IOPAR")=ADEIOPAR
  1.  . S DIC="^ADEDUM(",BY="@NUMBER",(FR,TO)=""
  1.  . S ADED0=0,ADED1=0
  1.  . ;FHL 9/9/98 I $D(ZTSK) S ADEZTSK=ZTSK K ZTSK
  1.  . I $D(ZTQUEUED) S ADEZTSK=ZTSK K ZTSK
  1.  . D EN1^DIP
  1.  . I $D(ADEZTSK) S ZTSK=ADEZTSK
  1. PRNEND I $D(ZTQUEUED) S ZTREQ="@"
  1.  I '$D(ADENOLOK) K ^TMP("ADEFPC",ADEU)
  1.  K ADENOLOK
  1.  Q
  1.  ;
  1. ASKDEV ;
  1.  K ADEIOP,IOP,ZTSK,ADEIOPAR
  1.  W !!,"Enter 'Q' at the DEVICE prompt to queue this report to run in the background."
  1.  S %ZIS="NQ"
  1.  D ^%ZIS
  1.  Q:POP
  1.  S ADEIOP=ION_";"_IOM_";"_IOSL
  1.  S ADEIOPAR=IOPAR
  1.  Q:'$D(IO("Q"))
  1.  D QUE
  1.  ;FHL 9/9/98 I '$D(ZTSK) K IOP,ADEIOP G ASKDEV
  1.  I '$D(ZTQUEUED) K IOP,ADEIOP G ASKDEV
  1.  D HOME^%ZIS
  1.  W !,"REPORT IS QUEUED!"
  1.  Q
  1.  ;
  1. QUE ;
  1.  N ADEJ
  1.  S ZTRTN="ZTM^ADEFPC",ZTDESC="FLUORIDE REPORT PROCESSING"
  1.  F ADEJ="ADEIOP","ADEBD","ADEED","ADECOMP","ADEU" S ZTSAVE(ADEJ)=""
  1.  S ZTSAVE("ADEIOPAR")=""
  1.  S ZTSAVE("ADEROPT")=""
  1.  S ZTIO=""
  1.  I $D(IO("HFSIO")) D
  1.  . S ZTIO=ADEIOP
  1.  D ^%ZTLOAD
  1.  Q
  1.  ;
  1. ADEU() ;GET UNIQUE SUBSCRIPT NUMBER AND LOCK REPORT NODE
  1.  ;RETURNS SUBSCRIPT NUMBER
  1.  S ADEU=$J
  1. ADEU1 F  L +^TMP("ADEFPC",ADEU):.1 Q:$T  S ADEU=ADEU+1
  1.  I $G(^TMP("ADEFPC",ADEU))="RUNNING" L -^TMP("ADEFPC",ADEU) S ADEU=ADEU+1 G ADEU1
  1.  Q ADEU