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

ADEKNT1.m

Go to the documentation of this file. 
  1. ADEKNT1 ; IHS/HQT/MJL - COMPILE DENTAL REPORTS ;   [ 04/03/2001  6:56 PM ]
  1.  ;;6.0;ADE;**7**;APR 03, 2001
  1.  ;
  1. ARRAY(ADESELOB) ;EP -Initialize counter arrays for each objective in ADESELOB
  1.  ;^TMP($J,"CTR",Objective,age)="QTR^YR^3YR^BeginDOB^EndDOB"
  1.  ;^TMP($J,"CTR",Objective,age,Facility)="QTR^YR^3YR^BeginDOB^EndDOB"
  1.  ;^TMP($J,"CTR",Objective,"LOGIC")="Set logic in ^ADEKOB(D0,1)"
  1.  ;
  1.  N ADEOBJ,ADENOD,ADEOBN,ADEGRP,ADEDOB1,ADEDOB2,I,J,K
  1.  S ADEOBJ=0
  1.  I ADESELOB["ALL" F  S ADEOBJ=$O(^ADEKOB(ADEOBJ)) Q:'+ADEOBJ  D ARRAY1
  1.  I ADESELOB'["ALL" F J=1:1:$L(ADESELOB,";") S ADEOBJ=+$P(ADESELOB,";",J) D:+ADEOBJ ARRAY1
  1.  I ADESELOB["USER" F J=1:1:6 S ADEOBJ=J D ARRAY1
  1.  I ADESELOB["DATE" D
  1.  . F  S ADEOBJ=$O(^ADEKOB("AD","v",ADEOBJ)) Q:'+ADEOBJ  D ARRAY1
  1.  . F  S ADEOBJ=$O(^ADEKOB("AD","d",ADEOBJ)) Q:'+ADEOBJ  D ARRAY1
  1.  Q
  1. ARRAY1 S ADENOD=^ADEKOB(ADEOBJ,0)
  1.  S ADEOBN=ADEOBJ
  1.  S ^TMP($J,"CTR",ADEOBN,"LOGIC")="LOGIC CODED"
  1.  I $D(^ADEKOB(ADEOBJ,1)) S ^TMP($J,"CTR",ADEOBJ,"LOGIC")=$P(^ADEKOB(ADEOBJ,1),U)
  1.  S ^TMP($J,"CTR",ADEOBJ,"LOGIC")=$TR(^TMP($J,"CTR",ADEOBJ,"LOGIC"),";","^")
  1.  S ADEGRP=$P(ADENOD,U,3)
  1.  S:ADEGRP="ALL" ADEGRP="0:125"
  1.  I ADEGRP="EACH" D
  1.  . N J
  1.  . S ADEGRP=""
  1.  . F J=0:1:74 S $P(ADEGRP,";",J+1)=J_":"_J
  1.  . S $P(ADEGRP,";",76)="75:125"
  1.  F I=1:1:$L(ADEGRP,";") D
  1.  . S ADEDOB1=$P($P(ADEGRP,";",I),":")
  1.  . S ADEDOB2=$P($P(ADEGRP,";",I),":",2)
  1.  . S ADEDOB1=ADEED-(ADEDOB1*10000)
  1.  . S ADEDOB2=ADEED+1-(10000*(ADEDOB2+1))
  1.  . S ^TMP($J,"CTR",ADEOBN,$P(ADEGRP,";",I))="0^0^0^"_ADEDOB2_U_ADEDOB1
  1.  . F K=1:1:$L(ADEFAC,"^") D
  1.  . . S ^TMP($J,"CTR",ADEOBN,$P(ADEGRP,";",I),$P(ADEFAC,U,K))="0^0^0^"_ADEDOB2_U_ADEDOB1
  1.  Q
  1.  ;
  1. DATE ;EP
  1.  ;Calculate Daily and Visit level objectives
  1.  ;
  1.  N ADEB,ADEDATE,ADECNT,ADE,ADE0130,ADE9170
  1.  N ADEL,ADENOD,ADEDDS,ADEVDATA,ADELOE
  1.  S ADEB=$P(ADE3BD,".")-1
  1.  S ADEDATE=ADEB
  1.  S ADECNT=0
  1.  S ADE0130=$O(^AUTTADA("B","0140",0))
  1.  S:'+ADE0130 ADE0130=0
  1.  S ADE9170=$O(^AUTTADA("B","9170",0))
  1.  S:'+ADE9170 ADE9170=0
  1.  ;
  1.  ;Starting with ADE3BD, $O thru ^ADEPCD("DATE"
  1.  F  S ADEB=$O(^ADEPCD("AC",ADEB)) Q:'+ADEB  Q:$P(ADEB,".")>ADEED  D
  1.  . ;If the Day has changed, do the daily objectives:
  1.  . ; and reset the date variable ADEDATE
  1.  . I $P(ADEB,".")>ADEDATE D
  1.  . . D DSTUFF(ADEDATE,ADECNT,"")
  1.  . . S ADEL="" F  S ADEL=$O(ADECNT(ADEL)) Q:'+ADEL  D
  1.  . . . Q:'+ADECNT(ADEL)
  1.  . . . D DSTUFF(ADEDATE,ADECNT(ADEL),ADEL)
  1.  . . ;Reset Date
  1.  . . S ADEDATE=$P(ADEB,".")
  1.  . . ;Reset Counter
  1.  . . K ADECNT S ADECNT=0
  1.  . . ;Kill Dentist Marker ADE( array
  1.  . . K ADE,ADELOE
  1.  . ;
  1.  . ;For each visit on that day:
  1.  . ;1) Increment both general and facility dentist-day counter:
  1.  . ;   get the dentist dfn ADEDDS
  1.  . ;   If dentist hasn't already been counted for that day
  1.  . ;   i.e., $D(ADE(ADEDDS))'=1 
  1.  . ;   then increment counter ADECNT and
  1.  . ;   set dentist marker array ADE(ADEDDS)=""
  1.  . ;   Do same for facility level counter ADELOE(ADEDDS)
  1.  . ;2) Call visit-level objectives:
  1.  . ;    Load visit data in ADEVDATA
  1.  . ;    Call VSTUFF(VisitData)
  1.  . ;
  1.  . S ADEC=0
  1.  . ; For each visit ADEC
  1.  . F  S ADEC=$O(^ADEPCD("AC",ADEB,ADEC)) Q:'+ADEC  D
  1.  . . ;
  1.  . . ;First, increment the dentist counter ADECNT if the dentist
  1.  . . ;hasn't already been counted i.e. '$D(ADE(ADEDDS))
  1.  . . Q:'$D(^ADEPCD(ADEC,0))
  1.  . . S ADENOD=^ADEPCD(ADEC,0)
  1.  . . S ADELOE=$P(ADENOD,U,3)
  1.  . . S ADEDDS=$P(ADENOD,U,4)
  1.  . . Q:'+ADEDDS
  1.  . . D  ;Increment dentist counter
  1.  . . . ;If dentist has not already been counted
  1.  . . . ; increment counter ADECNT
  1.  . . . ; and mark dentist as having been counted
  1.  . . . I '$D(ADE(ADEDDS)) D
  1.  . . . . S ADECNT=ADECNT+1
  1.  . . . . S ADE(ADEDDS)=""
  1.  . . . I '$D(ADELOE(ADEDDS)) D
  1.  . . . . I '$D(ADECNT(ADELOE)) S ADECNT(ADELOE)=0
  1.  . . . . S ADECNT(ADELOE)=ADECNT(ADELOE)+1
  1.  . . . . S ADELOE(ADEDDS)=""
  1.  . . . Q
  1.  . . ;Now get visit level data into ADEVDATA and call VSTUFF
  1.  . . ; In this version, the only visit level data is
  1.  . . ; a count of emergency visits
  1.  . . ; so $P(ADEVDATA,U,2) = 1 if the visit contains 9170 or 0140
  1.  . . ;
  1.  . . ;$P(ADEVDATA,U,1) = Native/Non-Native:
  1.  . . S $P(ADEVDATA,U)=$$INDIAN^ADEKNT($P(ADENOD,U))
  1.  . . ;Get DOB and set up ADEOBJ( array
  1.  . . S ADEDOB=$P($G(^DPT($P(ADENOD,U),0)),U,3)
  1.  . . Q:'+ADEDOB
  1.  . . D ADEOBJ^ADEKNT(ADEDOB)
  1.  . . S $P(ADEVDATA,U,2)=0
  1.  . . I $D(^ADEPCD(ADEC,"ADA","B",ADE0130)) S $P(ADEVDATA,U,2)=1
  1.  . . I $D(^ADEPCD(ADEC,"ADA","B",ADE9170)) S $P(ADEVDATA,U,2)=1
  1.  . . ; Future versions may store more in ADEVDATA, so will
  1.  . . ;  have to remove the IF in next line
  1.  . . Q:'+$P(ADEVDATA,U,2)
  1.  . . S $P(ADEVDATA,U,3)=ADELOE
  1.  . . D VSTUFF(ADEDATE,ADEVDATA)
  1.  . Q
  1.  ;
  1.  ;B  ;***Remove after testing
  1.  ;Pick up any data left over from last visit day:
  1.  D DSTUFF(ADEDATE,ADECNT,"")
  1.  S ADEL="" F  S ADEL=$O(ADECNT(ADEL)) Q:'+ADEL  D
  1.  . Q:'+ADECNT(ADEL)
  1.  . D DSTUFF(ADEDATE,ADECNT(ADEL),ADEL)
  1.  Q
  1.  ;
  1. DSTUFF(ADEDATE,ADEDDATA,ADELOE) ;EP - do DAILY objectives
  1.  ;Do DAILY objectives using the data in ADEDDATA
  1.  ;Call INCREM using date in ADEDATE, location ADELOE
  1.  ;
  1.  N ADEIEN,ADEOBJ
  1.  S ADEIEN=0
  1.  F  S ADEIEN=$O(^ADEKOB("AD","d",ADEIEN)) Q:'+ADEIEN  D
  1.  . ;Daily counters are not age-related, thus all are "0:125"
  1.  . S ADEOBJ(ADEIEN)="0:125"
  1.  . X ^TMP($J,"CTR",ADEIEN,"LOGIC")
  1.  Q
  1. VSTUFF(ADEDATE,ADEVDATA) ;EP - do VISIT objectives
  1.  ;Do VISIT objectives using the data in ADEDDATA
  1.  ;Call INCREM using date in ADEDATE
  1.  ;
  1.  N ADEIEN
  1.  S ADEIEN=0
  1.  F  S ADEIEN=$O(^ADEKOB("AD","v",ADEIEN)) Q:'+ADEIEN  D
  1.  . Q:'$D(ADEOBJ(ADEIEN))
  1.  . X ^TMP($J,"CTR",ADEIEN,"LOGIC") ;D EMVIS;ADEKNT1(ADEDATE,ADEVDATA,1)
  1.  Q
  1.  ;
  1. DENDAY(ADEVD,ADEDDATA,ADELOE) ;EP
  1.  ;
  1.  ;The first ^-piece of ADEDDATA is the number of dentists who
  1.  ; provided care on day ADEVD at location ADELOE
  1.  ; If ADELOE="" then the count is for all facilities
  1.  D INCREM^ADEKNT2(ADEIEN,ADEOBJ(ADEIEN),ADELOE,ADEVD,+ADEDDATA)
  1.  Q
  1.  ;
  1. EMVIS(ADEVD,ADEVDATA,ADELIM)        ;EP
  1.  ;
  1.  ;ADEVDATA is ^-piece 1 "1-ind 2-nonind 0-all"
  1.  ; ^-piece2 "1:Emergency visit, 0:not an emergency visit"
  1.  ; based on whether the visit had an 0130 or 9170 code
  1.  ; ^-piece3 is location
  1.  I ADELIM Q:'(ADELIM=+ADEVDATA)
  1.  Q:'+$P(ADEVDATA,U,2)
  1.  D INCREM^ADEKNT2(ADEIEN,ADEOBJ(ADEIEN),"",ADEVD,1)
  1.  D INCREM^ADEKNT2(ADEIEN,ADEOBJ(ADEIEN),$P(ADEVDATA,U,3),ADEVD,1)
  1.  Q