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

ADEKRP.m

Go to the documentation of this file. 
  1. ADEKRP ; IHS/HQT/MJL - PRINT COMPILED REPORTS ;  [ 03/24/1999   9:04 AM ]
  1.  ;;6.0;ADE;;APRIL 1999
  1.  ;
  1.  N ADEYQ,ADEROPT,ADEU,ADEIOP
  1.  K DTOUT,DUOUT,DIRUT,DIROUT
  1.  ;
  1.  ;Get report period, options (SINGLE, COMBINED, QUARTERLY, ANN)
  1. ASKYQ S ADEYQ=$$ASKYQ^ADEKRP3()
  1.  I 'ADEYQ D  G END
  1.  . Q:ADEYQ'="NO DATA"
  1.  . W !,"There are no compiled dental statistics stored on this machine."
  1.  . W !,"If the compiled statistics routines were installed within the"
  1.  . W !,"past few hours, then the compiler routines are probably running"
  1.  . W !,"now and haven't finished compiling yet."
  1.  . W !,"Otherwise, you can start the compiling process manually by"
  1.  . W !,"Executing the ECMP option (Compile Dental Quarterly Statistics)"
  1.  . W !,"in the DEO submenu of the DENTAL SUPERVISOR's menu."
  1.  S ADEROPT=$$ROPT^ADEKRP3()
  1.  G:ADEROPT="" ASKYQ
  1.  ;
  1.  ;GET AND LOCK UNIQUE SUBSCRIPT FOR THE REPORT GLOBAL
  1.  S ADEU=$$ADEU^ADEPSUB()
  1.  K ^TMP("ADEP",ADEU) ;^TMP is a transient report global
  1.  S ^TMP("ADEP",ADEU)="RUNNING"
  1.  ;
  1.  D ASKDEV^ADEKRP2("ZTM^ADEKRP","DENTAL OBJECTIVES REPORT PROCESSING")
  1.  I POP K ^TMP("ADEP",ADEU) G END
  1.  ;FHL 9/9/98 I $D(ZTSK) G END
  1.  I $D(ZTQUEUED) G END
  1.  ;
  1. ZTM ;EP - TASKMAN PROCESSING PHASE
  1.  I $D(ZTQUEUED) L +^TMP("ADEP",ADEU):1 I '$T S ZTREQ="@" G END
  1.  N ADEREP,ADEDDS,ADEDATE,ADESER,ADEDNAM,ADEWK1,ADEWK2,ADEWK3,ADEH,DIR,ADEASD,ADEDEN,ADEMED,ADEYQT
  1.  ;
  1.  ;IENs in ^ADEKOB for Medical, Dental and Assessed objectives:
  1.  S ADEMED=".3.",ADEDEN=".6.",ADEASD=".8."
  1.  ;
  1.  ;OLD: ADEPER=Quarterly (1) or Annual (0)
  1.  ;ADEPER="SQ","CQ","SA" OR "CA"
  1.  ;for Single or Combined, Quarterly or Annual
  1.  I ADEROPT["SINGLE-QUARTER" D SINGLE^ADEKRP6("SQ",ADEYQ)
  1.  ;Decrement ADEYQ by quarter, check for ADEKNT for that period
  1.  ;if so, do single
  1.  I ADEROPT["COMBINE-QUARTER" D SINGLE^ADEKRP6("CQ",ADEYQ) D
  1.  . S ADEYQT=ADEYQ
  1.  . S ADEH=2
  1.  . F  S ADEYQT=$$BACK(ADEYQT) Q:'$D(^ADEKNT("AD",ADEYQT_".3"))  Q:ADEH>5  D SINGLE^ADEKRP6("CQ",ADEYQT) S ADEH=ADEH+1
  1.  I ADEROPT["SINGLE-YEAR" D SINGLE^ADEKRP6("SA",ADEYQ)
  1.  I ADEROPT["COMBINE-YEAR" D SINGLE^ADEKRP6("CA",ADEYQ)
  1.  I ADEROPT["ANNUAL DENTAL BASIC MEASURES" D CF^ADEKRP5("ANNUAL",ADEYQ) D
  1.  . S ADEYQT=ADEYQ
  1.  . F  S ADEYQT=ADEYQT-1 Q:'$D(^ADEKNT("AD",ADEYQT_".3"))  D CF^ADEKRP5("ANNUAL",ADEYQT)
  1.  I ADEROPT["QUARTERLY DENTAL BASIC MEASURES" D CF^ADEKRP5("QUARTERLY",ADEYQ) D
  1.  . S ADEYQT=ADEYQ
  1.  . S ADEH=2
  1.  . F  S ADEYQT=$$BACK(ADEYQT) Q:'$D(^ADEKNT("AD",ADEYQT_".3"))  Q:ADEH>5  D CF^ADEKRP5("QUARTERLY",ADEYQT) S ADEH=ADEH+1
  1.  ;
  1.  ;
  1.  ;Q  ;***Quit here to examine ^TMP array
  1.  G:$O(^TMP("ADEP",ADEU,0))="" END
  1.  ;Call DIP to print array
  1.  I $D(ZTQUEUED) D  G END
  1.  . I $D(IOT),IOT'="HFS" D  Q
  1.  . . S ZTREQ=$H_U_ADEIOP_U_"DENTAL OBJECTIVES REPORT PRINTING"_U_"PRINT^ADEKRP1"
  1.  . D PRINT^ADEKRP1 Q
  1.  I '$D(ZTQUEUED) D PRINT^ADEKRP1
  1.  ;
  1. END K DUOUT,DTOUT,DIROUT,DIRUT
  1.  D END^ADEKRP2
  1.  Q
  1.  ;
  1.  ;
  1.  ;
  1. LOADFAC()          ;EP
  1.  ;Returns ^-delimited list of facilities in ADEPCD
  1.  N ADEFAC,ADERTN,ADECNT
  1.  S (ADEFAC,ADECNT)=0
  1.  S ADERTN=""
  1.  F  S ADEFAC=$O(^ADEPCD("ALOE",ADEFAC)) Q:'ADEFAC  D
  1.  . S ADECNT=ADECNT+1
  1.  . S $P(ADERTN,U,ADECNT)=ADEFAC
  1.  Q ADERTN
  1.  ;
  1. GETCNT(ADEYQ,ADEIEN,ADEAGEG) ;EP
  1.  ;Returns 'Quarter^Year^3-year' counts for all facilities
  1.  N ADENOD,ADE01,ADELAG,ADEUAG,ADECNT,J
  1.  S ADE01=ADEYQ_ADEIEN_ADEAGEG
  1.  I $D(^ADEKNT("B",ADE01)) D  Q ADE01
  1.  . S ADE01=$O(^ADEKNT("B",ADE01,0))
  1.  . S ADE01=^ADEKNT(ADE01,0)
  1.  . S ADE01=$P(ADE01,U,2,4)
  1.  S ADE01=$P(ADE01,".",1,3)
  1.  I '$D(^ADEKNT("AD",ADE01)) Q 0
  1.  S ADECNT="0^0^0"
  1.  S ADELAG=$P(ADEAGEG,":")-1
  1.  F  S ADELAG=$O(^ADEKNT("AD",ADE01,ADELAG)) Q:ADELAG=""  S ADENOD=$O(^ADEKNT("AD",ADE01,ADELAG,0)),ADEUAG=$P(^ADEKNT(ADENOD,0),U,9) Q:ADEUAG>$P(ADEAGEG,":",2)  D
  1.  . S ADENOD=$P(^ADEKNT(ADENOD,0),U,2,4)
  1.  . F J=1:1:3 S $P(ADECNT,U,J)=$P(ADECNT,U,J)+$P(ADENOD,U,J)
  1.  Q ADECNT
  1.  ;
  1. GETCNTEX(ADEYQ,ADEIEN,ADEAGEG,ADEFAC)  ;EP
  1.  ;Returns "Quarter^Year^3-year" counts for
  1.  ;Year.Quarter ADEYQ (YR.Q)
  1.  ;objective entry ADEIEN (.N.)
  1.  ;and age group ADEAGEG (YR:YR)
  1.  ;at facility ADEFAC
  1.  ;Returns 0 if no entry for ADEYQ_ADEIEN
  1.  ;Returns data for all facilities if +ADEFAC=0
  1.  ;
  1.  ;If a specific entry in ADEKNT exists for the objective/age
  1.  ;Returns values from that entry.
  1.  ;Otherwise, starts with lower age and adds values
  1.  ;of entries from ADEKNT thru upper range
  1.  ;
  1.  I '+ADEFAC Q:GETCNT(ADEYQ,ADEIEN,ADEAGEG)
  1.  ;
  1.  N ADENOD,ADE01,ADELAG,ADEUAG,ADECNT,J
  1.  S ADE01=ADEYQ_ADEIEN_ADEAGEG_"."_ADEFAC
  1.  I $D(^ADEKNT("B",ADE01)) D  Q ADE01
  1.  . S ADE01=$O(^ADEKNT("B",ADE01,0))
  1.  . S ADE01=^ADEKNT(ADE01,0)
  1.  . S ADE01=$P(ADE01,U,2,4)
  1.  ;B
  1.  S ADE01=$P(ADE01,".",1,3)_"."_ADEFAC
  1.  I '$D(^ADEKNT("AF",ADE01)) Q 0
  1.  S ADECNT="0^0^0"
  1.  S ADELAG=$P(ADEAGEG,":")-1
  1.  F  S ADELAG=$O(^ADEKNT("AF",ADE01,ADELAG)) Q:ADELAG=""  S ADENOD=$O(^ADEKNT("AF",ADE01,ADELAG,0)),ADEUAG=$P(^ADEKNT(ADENOD,0),U,9) Q:ADEUAG>$P(ADEAGEG,":",2)  D
  1.  . S ADENOD=$P(^ADEKNT(ADENOD,0),U,2,4)
  1.  . F J=1:1:3 S $P(ADECNT,U,J)=$P(ADECNT,U,J)+$P(ADENOD,U,J)
  1.  Q ADECNT
  1.  ;
  1. BACK(ADEYQ)        ;EP
  1.  ;Returns YYYY.Q 1 quarter prior to ADEYQ
  1.  ;
  1.  N ADEY,ADEQ
  1.  S ADEY=$P(ADEYQ,".")
  1.  ;beginning Y2K fix
  1.  Q:$L(ADEY)<4 0  ;Y2000
  1.  ;S:'ADEY ADEY=100
  1.  S ADEQ=+$P(ADEYQ,".",2)
  1.  Q:'ADEQ!(ADEQ>4) 0
  1.  S ADEQ=ADEQ-1
  1.  S:ADEQ=0 ADEQ=4,ADEY=ADEY-1 ;Y2000
  1.  ;end Y2K fix block
  1.  Q ADEY_"."_ADEQ