ADEKRP51 ; IHS/HQT/MJL - PRINT COMPILED REPORTS ; [ 03/24/1999 9:04 AM ]
;;6.0;ADE;**15,26**;JAN 01, 2004;Build 13
;;IHS/OIT/GAB 10.2014 Modified for 2015 Code Updates - PATCH 26
;
;Extension of report begun in ADEKRP5 (due to routine size)
;
EXT ;EP
;Get VISIT count (0190s + 0000)
S $P(@ADEPER@("2-VIS"),U,4)="DENTAL VISITS "_$S(ADEPC=2:"PAST 12 MONTHS",1:"THIS QUARTER")
S ADEM=$$GETCNT^ADEKRP(ADEYQ,ADE("VIS IND"),"0:125")
S $P(@ADEPER@("2-VIS"),U,1)=$P(ADEM,U,ADEPC)
S ADEM=$$GETCNT^ADEKRP(ADEYQ,ADE("VIS NON-IND"),"0:125")
S $P(@ADEPER@("2-VIS"),U,2)=$P(ADEM,U,ADEPC)
S $P(@ADEPER@("2-VIS"),U,3)=$P(@ADEPER@("2-VIS"),U,1)+$P(@ADEPER@("2-VIS"),U,2)
;
;Get SVC count
S $P(@ADEPER@("3-SVC"),U,4)="CLINICAL SERVICES (I-VI)"
S ADEM=$$GETCNT^ADEKRP(ADEYQ,ADE("SVC IND"),"0:125")
S $P(@ADEPER@("3-SVC"),U,1)=$P(ADEM,U,ADEPC)
S ADEM=$$GETCNT^ADEKRP(ADEYQ,ADE("SVC NON-IND"),"0:125")
S $P(@ADEPER@("3-SVC"),U,2)=$P(ADEM,U,ADEPC)
S $P(@ADEPER@("3-SVC"),U,3)=$P(@ADEPER@("3-SVC"),U,1)+$P(@ADEPER@("3-SVC"),U,2)
;
;Get SM count
S $P(@ADEPER@("4-MIN"),U,4)="SERVICE MINUTES (I-VI)"
S ADEM=$$GETCNT^ADEKRP(ADEYQ,ADE("MIN IND"),"0:125")
S $P(@ADEPER@("4-MIN"),U,1)=$P(ADEM,U,ADEPC)
S ADEM=$$GETCNT^ADEKRP(ADEYQ,ADE("MIN NON-IND"),"0:125")
S $P(@ADEPER@("4-MIN"),U,2)=$P(ADEM,U,ADEPC)
S $P(@ADEPER@("4-MIN"),U,3)=$P(@ADEPER@("4-MIN"),U,1)+$P(@ADEPER@("4-MIN"),U,2)
;
;----- BEGIN IHS MODIFICATIONS ADE*6.0*15
; Get RVU count
;"4.3-RVU" where 4.3 indicates report printing order
S $P(@ADEPER@("4.3-RVU"),U,4)="RELATIVE VALUE UNITS (I-VI)"
S ADEM=$$GETCNT^ADEKRP(ADEYQ,ADE("RVU IND"),"0:125")
S $P(@ADEPER@("4.3-RVU"),U,1)=$P(ADEM,U,ADEPC)
S ADEM=$$GETCNT^ADEKRP(ADEYQ,ADE("RVU NON-IND"),"0:125")
S $P(@ADEPER@("4.3-RVU"),U,2)=$P(ADEM,U,ADEPC)
S $P(@ADEPER@("4.3-RVU"),U,3)=$P(@ADEPER@("4.3-RVU"),U,1)+$P(@ADEPER@("4.3-RVU"),U,2)
;----- END IHS MODIFICATIONS
;
;Emergency Visits 4.5
S $P(@ADEPER@("4.5-EMER"),U,4)="EMERGENCY VISITS (0140-9170)"
S ADEM=$$GETCNT^ADEKRP(ADEYQ,ADE("EMERG VIS IND"),"0:125")
S $P(@ADEPER@("4.5-EMER"),U,1)=$P(ADEM,U,ADEPC)
S ADEM=$$GETCNT^ADEKRP(ADEYQ,ADE("EMERG VIS NON-IND"),"0:125")
S $P(@ADEPER@("4.5-EMER"),U,2)=$P(ADEM,U,ADEPC)
S $P(@ADEPER@("4.5-EMER"),U,3)=$P(@ADEPER@("4.5-EMER"),U,1)+$P(@ADEPER@("4.5-EMER"),U,2)
;
;Get BA count
;IHS/OIT/GAB 11.2014 Modified below line and added the next for 2015 Code updates - Patch #26
;S $P(@ADEPER@("5-BA"),U,4)="BROKEN APTS (9130)"
S $P(@ADEPER@("5-BA"),U,4)="BROKEN APTS (9130)"
S ADEM=$$GETCNT^ADEKRP(ADEYQ,ADE("BA"),"0:125")
S $P(@ADEPER@("5-BA"),U,3)=$P(ADEM,U,ADEPC)
;/IHS/OIT/GAB 1.2015 Added below line for 2015 Code Updates - Patch #26 added Broken appt code 9986
S $P(@ADEPER@("5.1-BA"),U,4)="BROKEN APTS(9986)"
S ADEM=$$GETCNT^ADEKRP(ADEYQ,ADE("BA2"),"0:125") ;
S $P(@ADEPER@("5.1-BA"),U,3)=$P(ADEM,U,ADEPC) ; ihs/gab check this.
;
;Get EXAM Count
S $P(@ADEPER@("5.2-EXAM"),U,4)="PATIENTS TREATMENT PLANNED"
S ADEM=$$GETCNT^ADEKRP(ADEYQ,ADE("EXAM IND"),"0:125")
S $P(@ADEPER@("5.2-EXAM"),U,1)=$P(ADEM,U,ADEPC)
S ADEM=$$GETCNT^ADEKRP(ADEYQ,ADE("EXAM NON-IND"),"0:125")
S $P(@ADEPER@("5.2-EXAM"),U,2)=$P(ADEM,U,ADEPC)
S $P(@ADEPER@("5.2-EXAM"),U,3)=$P(@ADEPER@("5.2-EXAM"),U,1)+$P(@ADEPER@("5.2-EXAM"),U,2)
;Get PTC Count
S $P(@ADEPER@("5.5-PTC"),U,4)="PATIENTS PLANNED TX COMPLETED"
S ADEM=$$GETCNT^ADEKRP(ADEYQ,ADE("PTC IND"),"0:125")
S $P(@ADEPER@("5.5-PTC"),U,1)=$P(ADEM,U,ADEPC)
S ADEM=$$GETCNT^ADEKRP(ADEYQ,ADE("PTC NON-IND"),"0:125")
S $P(@ADEPER@("5.5-PTC"),U,2)=$P(ADEM,U,ADEPC)
S $P(@ADEPER@("5.5-PTC"),U,3)=$P(@ADEPER@("5.5-PTC"),U,1)+$P(@ADEPER@("5.5-PTC"),U,2)
;
;Get DDAYS
S $P(@ADEPER@("6-DDAY"),U,4)="DENTIST-DAYS"
S ADEM=$$GETCNT^ADEKRP(ADEYQ,ADE("DDAY"),"0:125")
S $P(@ADEPER@("6-DDAY"),U,3)=$P(ADEM,U,ADEPC)
;
;CUM FY PATIENTS 7
I ADEPC=1 D
. S $P(@ADEPER@("7-CUM FY"),U,4)="PTS THIS FY - CUMULATIVE"
. S ADEM=$$GETCNT^ADEKRP(ADEYQ,ADE("FY NEW IND"),"0:125")
. S $P(@ADEPER@("7-CUM FY"),U,1)=$P(ADEM,U,2)
. S ADEM=$$GETCNT^ADEKRP(ADEYQ,ADE("FY NEW NON-IND"),"0:125")
. S $P(@ADEPER@("7-CUM FY"),U,2)=$P(ADEM,U,2)
. S $P(@ADEPER@("7-CUM FY"),U,3)=$P(@ADEPER@("7-CUM FY"),U,1)+$P(@ADEPER@("7-CUM FY"),U,2)
;
;FY PATS THIS QTR 8
I ADEPC=1 D
. S $P(@ADEPER@("8-QTR FY"),U,4)="PTS THIS FY - CURRENT"
. S ADEM=$$GETCNT^ADEKRP(ADEYQ,ADE("FY NEW IND"),"0:125")
. S $P(@ADEPER@("8-QTR FY"),U,1)=$P(ADEM,U,1)
. S ADEM=$$GETCNT^ADEKRP(ADEYQ,ADE("FY NEW NON-IND"),"0:125")
. S $P(@ADEPER@("8-QTR FY"),U,2)=$P(ADEM,U,1)
. S $P(@ADEPER@("8-QTR FY"),U,3)=$P(@ADEPER@("8-QTR FY"),U,1)+$P(@ADEPER@("8-QTR FY"),U,2)
;
Q
ADEKRP51 ; IHS/HQT/MJL - PRINT COMPILED REPORTS ; [ 03/24/1999 9:04 AM ]
+1 ;;6.0;ADE;**15,26**;JAN 01, 2004;Build 13
+2 ;;IHS/OIT/GAB 10.2014 Modified for 2015 Code Updates - PATCH 26
+3 ;
+4 ;Extension of report begun in ADEKRP5 (due to routine size)
+5 ;
EXT ;EP
+1 ;Get VISIT count (0190s + 0000)
+2 SET $PIECE(@ADEPER@("2-VIS"),U,4)="DENTAL VISITS "_$SELECT(ADEPC=2:"PAST 12 MONTHS",1:"THIS QUARTER")
+3 SET ADEM=$$GETCNT^ADEKRP(ADEYQ,ADE("VIS IND"),"0:125")
+4 SET $PIECE(@ADEPER@("2-VIS"),U,1)=$PIECE(ADEM,U,ADEPC)
+5 SET ADEM=$$GETCNT^ADEKRP(ADEYQ,ADE("VIS NON-IND"),"0:125")
+6 SET $PIECE(@ADEPER@("2-VIS"),U,2)=$PIECE(ADEM,U,ADEPC)
+7 SET $PIECE(@ADEPER@("2-VIS"),U,3)=$PIECE(@ADEPER@("2-VIS"),U,1)+$PIECE(@ADEPER@("2-VIS"),U,2)
+8 ;
+9 ;Get SVC count
+10 SET $PIECE(@ADEPER@("3-SVC"),U,4)="CLINICAL SERVICES (I-VI)"
+11 SET ADEM=$$GETCNT^ADEKRP(ADEYQ,ADE("SVC IND"),"0:125")
+12 SET $PIECE(@ADEPER@("3-SVC"),U,1)=$PIECE(ADEM,U,ADEPC)
+13 SET ADEM=$$GETCNT^ADEKRP(ADEYQ,ADE("SVC NON-IND"),"0:125")
+14 SET $PIECE(@ADEPER@("3-SVC"),U,2)=$PIECE(ADEM,U,ADEPC)
+15 SET $PIECE(@ADEPER@("3-SVC"),U,3)=$PIECE(@ADEPER@("3-SVC"),U,1)+$PIECE(@ADEPER@("3-SVC"),U,2)
+16 ;
+17 ;Get SM count
+18 SET $PIECE(@ADEPER@("4-MIN"),U,4)="SERVICE MINUTES (I-VI)"
+19 SET ADEM=$$GETCNT^ADEKRP(ADEYQ,ADE("MIN IND"),"0:125")
+20 SET $PIECE(@ADEPER@("4-MIN"),U,1)=$PIECE(ADEM,U,ADEPC)
+21 SET ADEM=$$GETCNT^ADEKRP(ADEYQ,ADE("MIN NON-IND"),"0:125")
+22 SET $PIECE(@ADEPER@("4-MIN"),U,2)=$PIECE(ADEM,U,ADEPC)
+23 SET $PIECE(@ADEPER@("4-MIN"),U,3)=$PIECE(@ADEPER@("4-MIN"),U,1)+$PIECE(@ADEPER@("4-MIN"),U,2)
+24 ;
+25 ;----- BEGIN IHS MODIFICATIONS ADE*6.0*15
+26 ; Get RVU count
+27 ;"4.3-RVU" where 4.3 indicates report printing order
+28 SET $PIECE(@ADEPER@("4.3-RVU"),U,4)="RELATIVE VALUE UNITS (I-VI)"
+29 SET ADEM=$$GETCNT^ADEKRP(ADEYQ,ADE("RVU IND"),"0:125")
+30 SET $PIECE(@ADEPER@("4.3-RVU"),U,1)=$PIECE(ADEM,U,ADEPC)
+31 SET ADEM=$$GETCNT^ADEKRP(ADEYQ,ADE("RVU NON-IND"),"0:125")
+32 SET $PIECE(@ADEPER@("4.3-RVU"),U,2)=$PIECE(ADEM,U,ADEPC)
+33 SET $PIECE(@ADEPER@("4.3-RVU"),U,3)=$PIECE(@ADEPER@("4.3-RVU"),U,1)+$PIECE(@ADEPER@("4.3-RVU"),U,2)
+34 ;----- END IHS MODIFICATIONS
+35 ;
+36 ;Emergency Visits 4.5
+37 SET $PIECE(@ADEPER@("4.5-EMER"),U,4)="EMERGENCY VISITS (0140-9170)"
+38 SET ADEM=$$GETCNT^ADEKRP(ADEYQ,ADE("EMERG VIS IND"),"0:125")
+39 SET $PIECE(@ADEPER@("4.5-EMER"),U,1)=$PIECE(ADEM,U,ADEPC)
+40 SET ADEM=$$GETCNT^ADEKRP(ADEYQ,ADE("EMERG VIS NON-IND"),"0:125")
+41 SET $PIECE(@ADEPER@("4.5-EMER"),U,2)=$PIECE(ADEM,U,ADEPC)
+42 SET $PIECE(@ADEPER@("4.5-EMER"),U,3)=$PIECE(@ADEPER@("4.5-EMER"),U,1)+$PIECE(@ADEPER@("4.5-EMER"),U,2)
+43 ;
+44 ;Get BA count
+45 ;IHS/OIT/GAB 11.2014 Modified below line and added the next for 2015 Code updates - Patch #26
+46 ;S $P(@ADEPER@("5-BA"),U,4)="BROKEN APTS (9130)"
+47 SET $PIECE(@ADEPER@("5-BA"),U,4)="BROKEN APTS (9130)"
+48 SET ADEM=$$GETCNT^ADEKRP(ADEYQ,ADE("BA"),"0:125")
+49 SET $PIECE(@ADEPER@("5-BA"),U,3)=$PIECE(ADEM,U,ADEPC)
+50 ;/IHS/OIT/GAB 1.2015 Added below line for 2015 Code Updates - Patch #26 added Broken appt code 9986
+51 SET $PIECE(@ADEPER@("5.1-BA"),U,4)="BROKEN APTS(9986)"
+52 ;
SET ADEM=$$GETCNT^ADEKRP(ADEYQ,ADE("BA2"),"0:125")
+53 ; ihs/gab check this.
SET $PIECE(@ADEPER@("5.1-BA"),U,3)=$PIECE(ADEM,U,ADEPC)
+54 ;
+55 ;Get EXAM Count
+56 SET $PIECE(@ADEPER@("5.2-EXAM"),U,4)="PATIENTS TREATMENT PLANNED"
+57 SET ADEM=$$GETCNT^ADEKRP(ADEYQ,ADE("EXAM IND"),"0:125")
+58 SET $PIECE(@ADEPER@("5.2-EXAM"),U,1)=$PIECE(ADEM,U,ADEPC)
+59 SET ADEM=$$GETCNT^ADEKRP(ADEYQ,ADE("EXAM NON-IND"),"0:125")
+60 SET $PIECE(@ADEPER@("5.2-EXAM"),U,2)=$PIECE(ADEM,U,ADEPC)
+61 SET $PIECE(@ADEPER@("5.2-EXAM"),U,3)=$PIECE(@ADEPER@("5.2-EXAM"),U,1)+$PIECE(@ADEPER@("5.2-EXAM"),U,2)
+62 ;Get PTC Count
+63 SET $PIECE(@ADEPER@("5.5-PTC"),U,4)="PATIENTS PLANNED TX COMPLETED"
+64 SET ADEM=$$GETCNT^ADEKRP(ADEYQ,ADE("PTC IND"),"0:125")
+65 SET $PIECE(@ADEPER@("5.5-PTC"),U,1)=$PIECE(ADEM,U,ADEPC)
+66 SET ADEM=$$GETCNT^ADEKRP(ADEYQ,ADE("PTC NON-IND"),"0:125")
+67 SET $PIECE(@ADEPER@("5.5-PTC"),U,2)=$PIECE(ADEM,U,ADEPC)
+68 SET $PIECE(@ADEPER@("5.5-PTC"),U,3)=$PIECE(@ADEPER@("5.5-PTC"),U,1)+$PIECE(@ADEPER@("5.5-PTC"),U,2)
+69 ;
+70 ;Get DDAYS
+71 SET $PIECE(@ADEPER@("6-DDAY"),U,4)="DENTIST-DAYS"
+72 SET ADEM=$$GETCNT^ADEKRP(ADEYQ,ADE("DDAY"),"0:125")
+73 SET $PIECE(@ADEPER@("6-DDAY"),U,3)=$PIECE(ADEM,U,ADEPC)
+74 ;
+75 ;CUM FY PATIENTS 7
+76 IF ADEPC=1
Begin DoDot:1
+77 SET $PIECE(@ADEPER@("7-CUM FY"),U,4)="PTS THIS FY - CUMULATIVE"
+78 SET ADEM=$$GETCNT^ADEKRP(ADEYQ,ADE("FY NEW IND"),"0:125")
+79 SET $PIECE(@ADEPER@("7-CUM FY"),U,1)=$PIECE(ADEM,U,2)
+80 SET ADEM=$$GETCNT^ADEKRP(ADEYQ,ADE("FY NEW NON-IND"),"0:125")
+81 SET $PIECE(@ADEPER@("7-CUM FY"),U,2)=$PIECE(ADEM,U,2)
+82 SET $PIECE(@ADEPER@("7-CUM FY"),U,3)=$PIECE(@ADEPER@("7-CUM FY"),U,1)+$PIECE(@ADEPER@("7-CUM FY"),U,2)
End DoDot:1
+83 ;
+84 ;FY PATS THIS QTR 8
+85 IF ADEPC=1
Begin DoDot:1
+86 SET $PIECE(@ADEPER@("8-QTR FY"),U,4)="PTS THIS FY - CURRENT"
+87 SET ADEM=$$GETCNT^ADEKRP(ADEYQ,ADE("FY NEW IND"),"0:125")
+88 SET $PIECE(@ADEPER@("8-QTR FY"),U,1)=$PIECE(ADEM,U,1)
+89 SET ADEM=$$GETCNT^ADEKRP(ADEYQ,ADE("FY NEW NON-IND"),"0:125")
+90 SET $PIECE(@ADEPER@("8-QTR FY"),U,2)=$PIECE(ADEM,U,1)
+91 SET $PIECE(@ADEPER@("8-QTR FY"),U,3)=$PIECE(@ADEPER@("8-QTR FY"),U,1)+$PIECE(@ADEPER@("8-QTR FY"),U,2)
End DoDot:1
+92 ;
+93 QUIT
