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

ADEKRP5.m

Go to the documentation of this file. 
  1. ADEKRP5 ; IHS/HQT/MJL - PRINT COMPILED REPORTS ;  [ 03/24/1999   9:04 AM ]
  1.  ;;6.0;ADE;**15,26**;JAN 01, 2004;Build 13
  1.  ;;IHS/OIT/GAB 10.2014 Modified for 2015 Code Updates - PATCH 26
  1.  ;
  1. CF(ADEPER,ADEYQ) ;EP
  1.  ;BASIC MEASURES REPORTS
  1.  N ADE,ADEM,ADEPC
  1.  ;
  1.  I ADEPER="ANNUAL" D
  1.  . S ADEPER="^TMP(""ADEP"",ADEU,""CF"",ADEYQ)"
  1.  . S ADEPC=2
  1.  E  D
  1.  . S ADEPER="^TMP(""ADEP"",ADEU,""CFQ"",ADEYQ)"
  1.  . S ADEPC=1
  1.  ;
  1.  D CONST
  1.  ;
  1.  ;Report Global is:
  1.  ;ADEREP("ADEP",ADEU,"CF",ADEYQ,"1-PTS")="Ind^Non-Indian^Total" (ANNUAL)
  1.  ;ADEREP("ADEP",ADEU,"CFQ",ADEYQ,"1-PTS")="Ind^Non-Indian^Total" (QR)
  1.  ; ...,".5-3YU")="Indian^Non-Indian^Total"
  1.  ; ...,".55-3YU")="Indian^Non-Indian^Total"
  1.  ; ...,"1.7-NEW USERS")="Indian^Non-Indian^Total"
  1.  ; ...,"1.75-NEW USERS")="Indian^Non-Indian^Total"
  1.  ; ...,"2-VIS")="Indian^Non-Indian^Total"
  1.  ; ...,"5.2-EXAM")
  1.  ; ...,"5.5-PTC")
  1.  ; ...,"3-SVC")
  1.  ; ...,"4-MIN")
  1.  ;IHS/OIT/GAB 11.2014 added the 9986 code to the below line for comment information for 2015 Code Updates PATCH #26
  1.  ; ...,"5-BA")="Total # of 9130 & 9986 codes"
  1.  ; ...,"6-DDAY")="Total Dentist Days"
  1.  ;----- BEGIN IHS
  1.  ; ...,"7-RVU")=Relative Value Unit"
  1.  ;
  1.  ;Get FACILITY USER count
  1.  ;Only for ANNUAL rept
  1.  I ADEPC=2 D
  1.  . S $P(@ADEPER@(".5-3YU"),U,4)="FACILITY USERS PAST "_$S(ADEPC=2:"36",1:"12")_" MONTHS"
  1.  . S ADEM=$$GETCNT^ADEKRP(ADEYQ,ADE("3YU IND"),"0:125")
  1.  . S $P(@ADEPER@(".5-3YU"),U,1)=$P(ADEM,U,ADEPC+1)
  1.  . S ADEM=$$GETCNT^ADEKRP(ADEYQ,ADE("3YU NON-IND"),"0:125")
  1.  . S $P(@ADEPER@(".5-3YU"),U,2)=$P(ADEM,U,ADEPC+1)
  1.  . S $P(@ADEPER@(".5-3YU"),U,3)=$P(@ADEPER@(".5-3YU"),U,1)+$P(@ADEPER@(".5-3YU"),U,2)
  1.  ;
  1.  S $P(@ADEPER@(".55-3YU"),U,4)="FACILITY USERS "_$S(ADEPC=2:"PAST 12 MONTHS",1:"THIS QUARTER")
  1.  S ADEM=$$GETCNT^ADEKRP(ADEYQ,ADE("3YU IND"),"0:125")
  1.  S $P(@ADEPER@(".55-3YU"),U,1)=$P(ADEM,U,ADEPC)
  1.  S ADEM=$$GETCNT^ADEKRP(ADEYQ,ADE("3YU NON-IND"),"0:125")
  1.  S $P(@ADEPER@(".55-3YU"),U,2)=$P(ADEM,U,ADEPC)
  1.  S $P(@ADEPER@(".55-3YU"),U,3)=$P(@ADEPER@(".55-3YU"),U,1)+$P(@ADEPER@(".55-3YU"),U,2)
  1.  ;
  1.  ;Get DENTAL PATIENT count
  1.  ;ANNUAL Period only
  1.  I ADEPC=2 D
  1.  . S $P(@ADEPER@("1-PTS"),U,4)="DENTAL USERS PAST "_$S(ADEPC=2:"36",1:"12")_" MONTHS"
  1.  . S ADEM=$$GETCNT^ADEKRP(ADEYQ,ADE("PTS IND"),"0:125")
  1.  . S $P(@ADEPER@("1-PTS"),U,1)=$P(ADEM,U,ADEPC+1)
  1.  . S ADEM=$$GETCNT^ADEKRP(ADEYQ,ADE("PTS NON-IND"),"0:125")
  1.  . S $P(@ADEPER@("1-PTS"),U,2)=$P(ADEM,U,ADEPC+1)
  1.  . S $P(@ADEPER@("1-PTS"),U,3)=$P(@ADEPER@("1-PTS"),U,1)+$P(@ADEPER@("1-PTS"),U,2)
  1.  ;
  1.  S $P(@ADEPER@("1.5-PTS"),U,4)="DENTAL USERS "_$S(ADEPC=2:"PAST 12 MONTHS",1:"THIS QUARTER")
  1.  S ADEM=$$GETCNT^ADEKRP(ADEYQ,ADE("PTS IND"),"0:125")
  1.  S $P(@ADEPER@("1.5-PTS"),U,1)=$P(ADEM,U,ADEPC)
  1.  S ADEM=$$GETCNT^ADEKRP(ADEYQ,ADE("PTS NON-IND"),"0:125")
  1.  S $P(@ADEPER@("1.5-PTS"),U,2)=$P(ADEM,U,ADEPC)
  1.  S $P(@ADEPER@("1.5-PTS"),U,3)=$P(@ADEPER@("1.5-PTS"),U,1)+$P(@ADEPER@("1.5-PTS"),U,2)
  1.  ;NEW DENTAL USERS
  1.  ;ANNUAL Period only
  1.  I ADEPC=2 D
  1.  . S $P(@ADEPER@("1.7-NEW USERS"),U,4)="NEW USERS PAST "_$S(ADEPC=2:"36",1:"12")_" MONTHS"
  1.  . S ADEM=$$GETCNT^ADEKRP(ADEYQ,ADE("3YR NEW IND"),"0:125")
  1.  . S $P(@ADEPER@("1.7-NEW USERS"),U,1)=$P(ADEM,U,ADEPC+1)
  1.  . S ADEM=$$GETCNT^ADEKRP(ADEYQ,ADE("3YR NEW NON-IND"),"0:125")
  1.  . S $P(@ADEPER@("1.7-NEW USERS"),U,2)=$P(ADEM,U,ADEPC+1)
  1.  . S $P(@ADEPER@("1.7-NEW USERS"),U,3)=$P(@ADEPER@("1.7-NEW USERS"),U,1)+$P(@ADEPER@("1.7-NEW USERS"),U,2)
  1.  ;
  1.  S $P(@ADEPER@("1.75-NEW USERS"),U,4)="NEW USERS "_$S(ADEPC=2:"PAST 12 MONTHS",1:"THIS QUARTER")
  1.  S ADEM=$$GETCNT^ADEKRP(ADEYQ,ADE("3YR NEW IND"),"0:125")
  1.  S $P(@ADEPER@("1.75-NEW USERS"),U,1)=$P(ADEM,U,ADEPC)
  1.  S ADEM=$$GETCNT^ADEKRP(ADEYQ,ADE("3YR NEW NON-IND"),"0:125")
  1.  S $P(@ADEPER@("1.75-NEW USERS"),U,2)=$P(ADEM,U,ADEPC)
  1.  S $P(@ADEPER@("1.75-NEW USERS"),U,3)=$P(@ADEPER@("1.75-NEW USERS"),U,1)+$P(@ADEPER@("1.75-NEW USERS"),U,2)
  1.  ;
  1.  ;
  1.  D EXT^ADEKRP51
  1.  Q
  1.  ;
  1. CONST ;EP
  1.  ;Constants
  1.  S ADE("3YU IND")=".1."
  1.  S ADE("3YU NON-IND")=".2."
  1.  S ADE("PTS ALL")=".6."
  1.  S ADE("PTS IND")=".4."
  1.  S ADE("PTS NON-IND")=".5."
  1.  S ADE("VIS IND")=".17."
  1.  S ADE("VIS NON-IND")=".18."
  1.  S ADE("PTC IND")=".15."
  1.  S ADE("PTC NON-IND")=".16."
  1.  S ADE("SVC IND")=".20."
  1.  S ADE("SVC NON-IND")=".21."
  1.  S ADE("MIN IND")=".22."
  1.  S ADE("MIN NON-IND")=".23."
  1.  S ADE("BA")=".19."
  1.  S ADE("DDAY")=".24."
  1.  S ADE("EXAM IND")=".25."
  1.  S ADE("EXAM NON-IND")=".26."
  1.  S ADE("FY NEW IND")=".27."
  1.  S ADE("FY NEW NON-IND")=".28."
  1.  S ADE("3YR NEW IND")=".29."
  1.  S ADE("3YR NEW NON-IND")=".30."
  1.  S ADE("EMERG VIS IND")=".31."
  1.  S ADE("EMERG VIS NON-IND")=".32."
  1.  ;----- BEGIN IHS MODIFICATIONS ADE*6.0*15
  1.  S ADE("RVU IND")=".33."
  1.  S ADE("RVU NON-IND")=".34."
  1.  ;----- IHS/OIT/GAB ADDED BELOW FOR 2015 CDT CODE UPDATES
  1.  S ADE("BA2")=".35."
  1.  ;----- END IHS MODIFICATIONS
  1.  Q