ADEKNT1 ; IHS/HQT/MJL - COMPILE DENTAL REPORTS ; [ 04/03/2001 6:56 PM ]
;;6.0;ADE;**7**;APR 03, 2001
;
ARRAY(ADESELOB) ;EP -Initialize counter arrays for each objective in ADESELOB
;^TMP($J,"CTR",Objective,age)="QTR^YR^3YR^BeginDOB^EndDOB"
;^TMP($J,"CTR",Objective,age,Facility)="QTR^YR^3YR^BeginDOB^EndDOB"
;^TMP($J,"CTR",Objective,"LOGIC")="Set logic in ^ADEKOB(D0,1)"
;
N ADEOBJ,ADENOD,ADEOBN,ADEGRP,ADEDOB1,ADEDOB2,I,J,K
S ADEOBJ=0
I ADESELOB["ALL" F S ADEOBJ=$O(^ADEKOB(ADEOBJ)) Q:'+ADEOBJ D ARRAY1
I ADESELOB'["ALL" F J=1:1:$L(ADESELOB,";") S ADEOBJ=+$P(ADESELOB,";",J) D:+ADEOBJ ARRAY1
I ADESELOB["USER" F J=1:1:6 S ADEOBJ=J D ARRAY1
I ADESELOB["DATE" D
. F S ADEOBJ=$O(^ADEKOB("AD","v",ADEOBJ)) Q:'+ADEOBJ D ARRAY1
. F S ADEOBJ=$O(^ADEKOB("AD","d",ADEOBJ)) Q:'+ADEOBJ D ARRAY1
Q
ARRAY1 S ADENOD=^ADEKOB(ADEOBJ,0)
S ADEOBN=ADEOBJ
S ^TMP($J,"CTR",ADEOBN,"LOGIC")="LOGIC CODED"
I $D(^ADEKOB(ADEOBJ,1)) S ^TMP($J,"CTR",ADEOBJ,"LOGIC")=$P(^ADEKOB(ADEOBJ,1),U)
S ^TMP($J,"CTR",ADEOBJ,"LOGIC")=$TR(^TMP($J,"CTR",ADEOBJ,"LOGIC"),";","^")
S ADEGRP=$P(ADENOD,U,3)
S:ADEGRP="ALL" ADEGRP="0:125"
I ADEGRP="EACH" D
. N J
. S ADEGRP=""
. F J=0:1:74 S $P(ADEGRP,";",J+1)=J_":"_J
. S $P(ADEGRP,";",76)="75:125"
F I=1:1:$L(ADEGRP,";") D
. S ADEDOB1=$P($P(ADEGRP,";",I),":")
. S ADEDOB2=$P($P(ADEGRP,";",I),":",2)
. S ADEDOB1=ADEED-(ADEDOB1*10000)
. S ADEDOB2=ADEED+1-(10000*(ADEDOB2+1))
. S ^TMP($J,"CTR",ADEOBN,$P(ADEGRP,";",I))="0^0^0^"_ADEDOB2_U_ADEDOB1
. F K=1:1:$L(ADEFAC,"^") D
. . S ^TMP($J,"CTR",ADEOBN,$P(ADEGRP,";",I),$P(ADEFAC,U,K))="0^0^0^"_ADEDOB2_U_ADEDOB1
Q
;
DATE ;EP
;Calculate Daily and Visit level objectives
;
N ADEB,ADEDATE,ADECNT,ADE,ADE0130,ADE9170
N ADEL,ADENOD,ADEDDS,ADEVDATA,ADELOE
S ADEB=$P(ADE3BD,".")-1
S ADEDATE=ADEB
S ADECNT=0
S ADE0130=$O(^AUTTADA("B","0140",0))
S:'+ADE0130 ADE0130=0
S ADE9170=$O(^AUTTADA("B","9170",0))
S:'+ADE9170 ADE9170=0
;
;Starting with ADE3BD, $O thru ^ADEPCD("DATE"
F S ADEB=$O(^ADEPCD("AC",ADEB)) Q:'+ADEB Q:$P(ADEB,".")>ADEED D
. ;If the Day has changed, do the daily objectives:
. ; and reset the date variable ADEDATE
. I $P(ADEB,".")>ADEDATE D
. . D DSTUFF(ADEDATE,ADECNT,"")
. . S ADEL="" F S ADEL=$O(ADECNT(ADEL)) Q:'+ADEL D
. . . Q:'+ADECNT(ADEL)
. . . D DSTUFF(ADEDATE,ADECNT(ADEL),ADEL)
. . ;Reset Date
. . S ADEDATE=$P(ADEB,".")
. . ;Reset Counter
. . K ADECNT S ADECNT=0
. . ;Kill Dentist Marker ADE( array
. . K ADE,ADELOE
. ;
. ;For each visit on that day:
. ;1) Increment both general and facility dentist-day counter:
. ; get the dentist dfn ADEDDS
. ; If dentist hasn't already been counted for that day
. ; i.e., $D(ADE(ADEDDS))'=1
. ; then increment counter ADECNT and
. ; set dentist marker array ADE(ADEDDS)=""
. ; Do same for facility level counter ADELOE(ADEDDS)
. ;2) Call visit-level objectives:
. ; Load visit data in ADEVDATA
. ; Call VSTUFF(VisitData)
. ;
. S ADEC=0
. ; For each visit ADEC
. F S ADEC=$O(^ADEPCD("AC",ADEB,ADEC)) Q:'+ADEC D
. . ;
. . ;First, increment the dentist counter ADECNT if the dentist
. . ;hasn't already been counted i.e. '$D(ADE(ADEDDS))
. . Q:'$D(^ADEPCD(ADEC,0))
. . S ADENOD=^ADEPCD(ADEC,0)
. . S ADELOE=$P(ADENOD,U,3)
. . S ADEDDS=$P(ADENOD,U,4)
. . Q:'+ADEDDS
. . D ;Increment dentist counter
. . . ;If dentist has not already been counted
. . . ; increment counter ADECNT
. . . ; and mark dentist as having been counted
. . . I '$D(ADE(ADEDDS)) D
. . . . S ADECNT=ADECNT+1
. . . . S ADE(ADEDDS)=""
. . . I '$D(ADELOE(ADEDDS)) D
. . . . I '$D(ADECNT(ADELOE)) S ADECNT(ADELOE)=0
. . . . S ADECNT(ADELOE)=ADECNT(ADELOE)+1
. . . . S ADELOE(ADEDDS)=""
. . . Q
. . ;Now get visit level data into ADEVDATA and call VSTUFF
. . ; In this version, the only visit level data is
. . ; a count of emergency visits
. . ; so $P(ADEVDATA,U,2) = 1 if the visit contains 9170 or 0140
. . ;
. . ;$P(ADEVDATA,U,1) = Native/Non-Native:
. . S $P(ADEVDATA,U)=$$INDIAN^ADEKNT($P(ADENOD,U))
. . ;Get DOB and set up ADEOBJ( array
. . S ADEDOB=$P($G(^DPT($P(ADENOD,U),0)),U,3)
. . Q:'+ADEDOB
. . D ADEOBJ^ADEKNT(ADEDOB)
. . S $P(ADEVDATA,U,2)=0
. . I $D(^ADEPCD(ADEC,"ADA","B",ADE0130)) S $P(ADEVDATA,U,2)=1
. . I $D(^ADEPCD(ADEC,"ADA","B",ADE9170)) S $P(ADEVDATA,U,2)=1
. . ; Future versions may store more in ADEVDATA, so will
. . ; have to remove the IF in next line
. . Q:'+$P(ADEVDATA,U,2)
. . S $P(ADEVDATA,U,3)=ADELOE
. . D VSTUFF(ADEDATE,ADEVDATA)
. Q
;
;B ;***Remove after testing
;Pick up any data left over from last visit day:
D DSTUFF(ADEDATE,ADECNT,"")
S ADEL="" F S ADEL=$O(ADECNT(ADEL)) Q:'+ADEL D
. Q:'+ADECNT(ADEL)
. D DSTUFF(ADEDATE,ADECNT(ADEL),ADEL)
Q
;
DSTUFF(ADEDATE,ADEDDATA,ADELOE) ;EP - do DAILY objectives
;Do DAILY objectives using the data in ADEDDATA
;Call INCREM using date in ADEDATE, location ADELOE
;
N ADEIEN,ADEOBJ
S ADEIEN=0
F S ADEIEN=$O(^ADEKOB("AD","d",ADEIEN)) Q:'+ADEIEN D
. ;Daily counters are not age-related, thus all are "0:125"
. S ADEOBJ(ADEIEN)="0:125"
. X ^TMP($J,"CTR",ADEIEN,"LOGIC")
Q
VSTUFF(ADEDATE,ADEVDATA) ;EP - do VISIT objectives
;Do VISIT objectives using the data in ADEDDATA
;Call INCREM using date in ADEDATE
;
N ADEIEN
S ADEIEN=0
F S ADEIEN=$O(^ADEKOB("AD","v",ADEIEN)) Q:'+ADEIEN D
. Q:'$D(ADEOBJ(ADEIEN))
. X ^TMP($J,"CTR",ADEIEN,"LOGIC") ;D EMVIS;ADEKNT1(ADEDATE,ADEVDATA,1)
Q
;
DENDAY(ADEVD,ADEDDATA,ADELOE) ;EP
;
;The first ^-piece of ADEDDATA is the number of dentists who
; provided care on day ADEVD at location ADELOE
; If ADELOE="" then the count is for all facilities
D INCREM^ADEKNT2(ADEIEN,ADEOBJ(ADEIEN),ADELOE,ADEVD,+ADEDDATA)
Q
;
EMVIS(ADEVD,ADEVDATA,ADELIM) ;EP
;
;ADEVDATA is ^-piece 1 "1-ind 2-nonind 0-all"
; ^-piece2 "1:Emergency visit, 0:not an emergency visit"
; based on whether the visit had an 0130 or 9170 code
; ^-piece3 is location
I ADELIM Q:'(ADELIM=+ADEVDATA)
Q:'+$P(ADEVDATA,U,2)
D INCREM^ADEKNT2(ADEIEN,ADEOBJ(ADEIEN),"",ADEVD,1)
D INCREM^ADEKNT2(ADEIEN,ADEOBJ(ADEIEN),$P(ADEVDATA,U,3),ADEVD,1)
Q
ADEKNT1 ; IHS/HQT/MJL - COMPILE DENTAL REPORTS ; [ 04/03/2001 6:56 PM ]
+1 ;;6.0;ADE;**7**;APR 03, 2001
+2 ;
ARRAY(ADESELOB) ;EP -Initialize counter arrays for each objective in ADESELOB
+1 ;^TMP($J,"CTR",Objective,age)="QTR^YR^3YR^BeginDOB^EndDOB"
+2 ;^TMP($J,"CTR",Objective,age,Facility)="QTR^YR^3YR^BeginDOB^EndDOB"
+3 ;^TMP($J,"CTR",Objective,"LOGIC")="Set logic in ^ADEKOB(D0,1)"
+4 ;
+5 NEW ADEOBJ,ADENOD,ADEOBN,ADEGRP,ADEDOB1,ADEDOB2,I,J,K
+6 SET ADEOBJ=0
+7 IF ADESELOB["ALL"
FOR
SET ADEOBJ=$ORDER(^ADEKOB(ADEOBJ))
IF '+ADEOBJ
QUIT
DO ARRAY1
+8 IF ADESELOB'["ALL"
FOR J=1:1:$LENGTH(ADESELOB,";")
SET ADEOBJ=+$PIECE(ADESELOB,";",J)
IF +ADEOBJ
DO ARRAY1
+9 IF ADESELOB["USER"
FOR J=1:1:6
SET ADEOBJ=J
DO ARRAY1
+10 IF ADESELOB["DATE"
Begin DoDot:1
+11 FOR
SET ADEOBJ=$ORDER(^ADEKOB("AD","v",ADEOBJ))
IF '+ADEOBJ
QUIT
DO ARRAY1
+12 FOR
SET ADEOBJ=$ORDER(^ADEKOB("AD","d",ADEOBJ))
IF '+ADEOBJ
QUIT
DO ARRAY1
End DoDot:1
+13 QUIT
ARRAY1 SET ADENOD=^ADEKOB(ADEOBJ,0)
+1 SET ADEOBN=ADEOBJ
+2 SET ^TMP($JOB,"CTR",ADEOBN,"LOGIC")="LOGIC CODED"
+3 IF $DATA(^ADEKOB(ADEOBJ,1))
SET ^TMP($JOB,"CTR",ADEOBJ,"LOGIC")=$PIECE(^ADEKOB(ADEOBJ,1),U)
+4 SET ^TMP($JOB,"CTR",ADEOBJ,"LOGIC")=$TRANSLATE(^TMP($JOB,"CTR",ADEOBJ,"LOGIC"),";","^")
+5 SET ADEGRP=$PIECE(ADENOD,U,3)
+6 IF ADEGRP="ALL"
SET ADEGRP="0:125"
+7 IF ADEGRP="EACH"
Begin DoDot:1
+8 NEW J
+9 SET ADEGRP=""
+10 FOR J=0:1:74
SET $PIECE(ADEGRP,";",J+1)=J_":"_J
+11 SET $PIECE(ADEGRP,";",76)="75:125"
End DoDot:1
+12 FOR I=1:1:$LENGTH(ADEGRP,";")
Begin DoDot:1
+13 SET ADEDOB1=$PIECE($PIECE(ADEGRP,";",I),":")
+14 SET ADEDOB2=$PIECE($PIECE(ADEGRP,";",I),":",2)
+15 SET ADEDOB1=ADEED-(ADEDOB1*10000)
+16 SET ADEDOB2=ADEED+1-(10000*(ADEDOB2+1))
+17 SET ^TMP($JOB,"CTR",ADEOBN,$PIECE(ADEGRP,";",I))="0^0^0^"_ADEDOB2_U_ADEDOB1
+18 FOR K=1:1:$LENGTH(ADEFAC,"^")
Begin DoDot:2
+19 SET ^TMP($JOB,"CTR",ADEOBN,$PIECE(ADEGRP,";",I),$PIECE(ADEFAC,U,K))="0^0^0^"_ADEDOB2_U_ADEDOB1
End DoDot:2
End DoDot:1
+20 QUIT
+21 ;
DATE ;EP
+1 ;Calculate Daily and Visit level objectives
+2 ;
+3 NEW ADEB,ADEDATE,ADECNT,ADE,ADE0130,ADE9170
+4 NEW ADEL,ADENOD,ADEDDS,ADEVDATA,ADELOE
+5 SET ADEB=$PIECE(ADE3BD,".")-1
+6 SET ADEDATE=ADEB
+7 SET ADECNT=0
+8 SET ADE0130=$ORDER(^AUTTADA("B","0140",0))
+9 IF '+ADE0130
SET ADE0130=0
+10 SET ADE9170=$ORDER(^AUTTADA("B","9170",0))
+11 IF '+ADE9170
SET ADE9170=0
+12 ;
+13 ;Starting with ADE3BD, $O thru ^ADEPCD("DATE"
+14 FOR
SET ADEB=$ORDER(^ADEPCD("AC",ADEB))
IF '+ADEB
QUIT
IF $PIECE(ADEB,".")>ADEED
QUIT
Begin DoDot:1
+15 ;If the Day has changed, do the daily objectives:
+16 ; and reset the date variable ADEDATE
+17 IF $PIECE(ADEB,".")>ADEDATE
Begin DoDot:2
+18 DO DSTUFF(ADEDATE,ADECNT,"")
+19 SET ADEL=""
FOR
SET ADEL=$ORDER(ADECNT(ADEL))
IF '+ADEL
QUIT
Begin DoDot:3
+20 IF '+ADECNT(ADEL)
QUIT
+21 DO DSTUFF(ADEDATE,ADECNT(ADEL),ADEL)
End DoDot:3
+22 ;Reset Date
+23 SET ADEDATE=$PIECE(ADEB,".")
+24 ;Reset Counter
+25 KILL ADECNT
SET ADECNT=0
+26 ;Kill Dentist Marker ADE( array
+27 KILL ADE,ADELOE
End DoDot:2
+28 ;
+29 ;For each visit on that day:
+30 ;1) Increment both general and facility dentist-day counter:
+31 ; get the dentist dfn ADEDDS
+32 ; If dentist hasn't already been counted for that day
+33 ; i.e., $D(ADE(ADEDDS))'=1
+34 ; then increment counter ADECNT and
+35 ; set dentist marker array ADE(ADEDDS)=""
+36 ; Do same for facility level counter ADELOE(ADEDDS)
+37 ;2) Call visit-level objectives:
+38 ; Load visit data in ADEVDATA
+39 ; Call VSTUFF(VisitData)
+40 ;
+41 SET ADEC=0
+42 ; For each visit ADEC
+43 FOR
SET ADEC=$ORDER(^ADEPCD("AC",ADEB,ADEC))
IF '+ADEC
QUIT
Begin DoDot:2
+44 ;
+45 ;First, increment the dentist counter ADECNT if the dentist
+46 ;hasn't already been counted i.e. '$D(ADE(ADEDDS))
+47 IF '$DATA(^ADEPCD(ADEC,0))
QUIT
+48 SET ADENOD=^ADEPCD(ADEC,0)
+49 SET ADELOE=$PIECE(ADENOD,U,3)
+50 SET ADEDDS=$PIECE(ADENOD,U,4)
+51 IF '+ADEDDS
QUIT
+52 ;Increment dentist counter
Begin DoDot:3
+53 ;If dentist has not already been counted
+54 ; increment counter ADECNT
+55 ; and mark dentist as having been counted
+56 IF '$DATA(ADE(ADEDDS))
Begin DoDot:4
+57 SET ADECNT=ADECNT+1
+58 SET ADE(ADEDDS)=""
End DoDot:4
+59 IF '$DATA(ADELOE(ADEDDS))
Begin DoDot:4
+60 IF '$DATA(ADECNT(ADELOE))
SET ADECNT(ADELOE)=0
+61 SET ADECNT(ADELOE)=ADECNT(ADELOE)+1
+62 SET ADELOE(ADEDDS)=""
End DoDot:4
+63 QUIT
End DoDot:3
+64 ;Now get visit level data into ADEVDATA and call VSTUFF
+65 ; In this version, the only visit level data is
+66 ; a count of emergency visits
+67 ; so $P(ADEVDATA,U,2) = 1 if the visit contains 9170 or 0140
+68 ;
+69 ;$P(ADEVDATA,U,1) = Native/Non-Native:
+70 SET $PIECE(ADEVDATA,U)=$$INDIAN^ADEKNT($PIECE(ADENOD,U))
+71 ;Get DOB and set up ADEOBJ( array
+72 SET ADEDOB=$PIECE($GET(^DPT($PIECE(ADENOD,U),0)),U,3)
+73 IF '+ADEDOB
QUIT
+74 DO ADEOBJ^ADEKNT(ADEDOB)
+75 SET $PIECE(ADEVDATA,U,2)=0
+76 IF $DATA(^ADEPCD(ADEC,"ADA","B",ADE0130))
SET $PIECE(ADEVDATA,U,2)=1
+77 IF $DATA(^ADEPCD(ADEC,"ADA","B",ADE9170))
SET $PIECE(ADEVDATA,U,2)=1
+78 ; Future versions may store more in ADEVDATA, so will
+79 ; have to remove the IF in next line
+80 IF '+$PIECE(ADEVDATA,U,2)
QUIT
+81 SET $PIECE(ADEVDATA,U,3)=ADELOE
+82 DO VSTUFF(ADEDATE,ADEVDATA)
End DoDot:2
+83 QUIT
End DoDot:1
+84 ;
+85 ;B ;***Remove after testing
+86 ;Pick up any data left over from last visit day:
+87 DO DSTUFF(ADEDATE,ADECNT,"")
+88 SET ADEL=""
FOR
SET ADEL=$ORDER(ADECNT(ADEL))
IF '+ADEL
QUIT
Begin DoDot:1
+89 IF '+ADECNT(ADEL)
QUIT
+90 DO DSTUFF(ADEDATE,ADECNT(ADEL),ADEL)
End DoDot:1
+91 QUIT
+92 ;
DSTUFF(ADEDATE,ADEDDATA,ADELOE) ;EP - do DAILY objectives
+1 ;Do DAILY objectives using the data in ADEDDATA
+2 ;Call INCREM using date in ADEDATE, location ADELOE
+3 ;
+4 NEW ADEIEN,ADEOBJ
+5 SET ADEIEN=0
+6 FOR
SET ADEIEN=$ORDER(^ADEKOB("AD","d",ADEIEN))
IF '+ADEIEN
QUIT
Begin DoDot:1
+7 ;Daily counters are not age-related, thus all are "0:125"
+8 SET ADEOBJ(ADEIEN)="0:125"
+9 XECUTE ^TMP($JOB,"CTR",ADEIEN,"LOGIC")
End DoDot:1
+10 QUIT
VSTUFF(ADEDATE,ADEVDATA) ;EP - do VISIT objectives
+1 ;Do VISIT objectives using the data in ADEDDATA
+2 ;Call INCREM using date in ADEDATE
+3 ;
+4 NEW ADEIEN
+5 SET ADEIEN=0
+6 FOR
SET ADEIEN=$ORDER(^ADEKOB("AD","v",ADEIEN))
IF '+ADEIEN
QUIT
Begin DoDot:1
+7 IF '$DATA(ADEOBJ(ADEIEN))
QUIT
+8 ;D EMVIS;ADEKNT1(ADEDATE,ADEVDATA,1)
XECUTE ^TMP($JOB,"CTR",ADEIEN,"LOGIC")
End DoDot:1
+9 QUIT
+10 ;
DENDAY(ADEVD,ADEDDATA,ADELOE) ;EP
+1 ;
+2 ;The first ^-piece of ADEDDATA is the number of dentists who
+3 ; provided care on day ADEVD at location ADELOE
+4 ; If ADELOE="" then the count is for all facilities
+5 DO INCREM^ADEKNT2(ADEIEN,ADEOBJ(ADEIEN),ADELOE,ADEVD,+ADEDDATA)
+6 QUIT
+7 ;
EMVIS(ADEVD,ADEVDATA,ADELIM) ;EP
+1 ;
+2 ;ADEVDATA is ^-piece 1 "1-ind 2-nonind 0-all"
+3 ; ^-piece2 "1:Emergency visit, 0:not an emergency visit"
+4 ; based on whether the visit had an 0130 or 9170 code
+5 ; ^-piece3 is location
+6 IF ADELIM
IF '(ADELIM=+ADEVDATA)
QUIT
+7 IF '+$PIECE(ADEVDATA,U,2)
QUIT
+8 DO INCREM^ADEKNT2(ADEIEN,ADEOBJ(ADEIEN),"",ADEVD,1)
+9 DO INCREM^ADEKNT2(ADEIEN,ADEOBJ(ADEIEN),$PIECE(ADEVDATA,U,3),ADEVD,1)
+10 QUIT
