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

ADEKRP51.m

Go to the documentation of this file. 
  1. ADEKRP51 ; 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.  ;Extension of report begun in ADEKRP5 (due to routine size)
  1.  ;
  1. EXT ;EP
  1.  ;Get VISIT count (0190s + 0000)
  1.  S $P(@ADEPER@("2-VIS"),U,4)="DENTAL VISITS "_$S(ADEPC=2:"PAST 12 MONTHS",1:"THIS QUARTER")
  1.  S ADEM=$$GETCNT^ADEKRP(ADEYQ,ADE("VIS IND"),"0:125")
  1.  S $P(@ADEPER@("2-VIS"),U,1)=$P(ADEM,U,ADEPC)
  1.  S ADEM=$$GETCNT^ADEKRP(ADEYQ,ADE("VIS NON-IND"),"0:125")
  1.  S $P(@ADEPER@("2-VIS"),U,2)=$P(ADEM,U,ADEPC)
  1.  S $P(@ADEPER@("2-VIS"),U,3)=$P(@ADEPER@("2-VIS"),U,1)+$P(@ADEPER@("2-VIS"),U,2)
  1.  ;
  1.  ;Get SVC count
  1.  S $P(@ADEPER@("3-SVC"),U,4)="CLINICAL SERVICES (I-VI)"
  1.  S ADEM=$$GETCNT^ADEKRP(ADEYQ,ADE("SVC IND"),"0:125")
  1.  S $P(@ADEPER@("3-SVC"),U,1)=$P(ADEM,U,ADEPC)
  1.  S ADEM=$$GETCNT^ADEKRP(ADEYQ,ADE("SVC NON-IND"),"0:125")
  1.  S $P(@ADEPER@("3-SVC"),U,2)=$P(ADEM,U,ADEPC)
  1.  S $P(@ADEPER@("3-SVC"),U,3)=$P(@ADEPER@("3-SVC"),U,1)+$P(@ADEPER@("3-SVC"),U,2)
  1.  ;
  1.  ;Get SM count
  1.  S $P(@ADEPER@("4-MIN"),U,4)="SERVICE MINUTES (I-VI)"
  1.  S ADEM=$$GETCNT^ADEKRP(ADEYQ,ADE("MIN IND"),"0:125")
  1.  S $P(@ADEPER@("4-MIN"),U,1)=$P(ADEM,U,ADEPC)
  1.  S ADEM=$$GETCNT^ADEKRP(ADEYQ,ADE("MIN NON-IND"),"0:125")
  1.  S $P(@ADEPER@("4-MIN"),U,2)=$P(ADEM,U,ADEPC)
  1.  S $P(@ADEPER@("4-MIN"),U,3)=$P(@ADEPER@("4-MIN"),U,1)+$P(@ADEPER@("4-MIN"),U,2)
  1.  ;
  1.  ;----- BEGIN IHS MODIFICATIONS ADE*6.0*15
  1.  ; Get RVU count
  1.  ;"4.3-RVU" where 4.3 indicates report printing order
  1.  S $P(@ADEPER@("4.3-RVU"),U,4)="RELATIVE VALUE UNITS (I-VI)"
  1.  S ADEM=$$GETCNT^ADEKRP(ADEYQ,ADE("RVU IND"),"0:125")
  1.  S $P(@ADEPER@("4.3-RVU"),U,1)=$P(ADEM,U,ADEPC)
  1.  S ADEM=$$GETCNT^ADEKRP(ADEYQ,ADE("RVU NON-IND"),"0:125")
  1.  S $P(@ADEPER@("4.3-RVU"),U,2)=$P(ADEM,U,ADEPC)
  1.  S $P(@ADEPER@("4.3-RVU"),U,3)=$P(@ADEPER@("4.3-RVU"),U,1)+$P(@ADEPER@("4.3-RVU"),U,2)
  1.  ;----- END IHS MODIFICATIONS
  1.  ;
  1.  ;Emergency Visits 4.5
  1.  S $P(@ADEPER@("4.5-EMER"),U,4)="EMERGENCY VISITS (0140-9170)"
  1.  S ADEM=$$GETCNT^ADEKRP(ADEYQ,ADE("EMERG VIS IND"),"0:125")
  1.  S $P(@ADEPER@("4.5-EMER"),U,1)=$P(ADEM,U,ADEPC)
  1.  S ADEM=$$GETCNT^ADEKRP(ADEYQ,ADE("EMERG VIS NON-IND"),"0:125")
  1.  S $P(@ADEPER@("4.5-EMER"),U,2)=$P(ADEM,U,ADEPC)
  1.  S $P(@ADEPER@("4.5-EMER"),U,3)=$P(@ADEPER@("4.5-EMER"),U,1)+$P(@ADEPER@("4.5-EMER"),U,2)
  1.  ;
  1.  ;Get BA count
  1.  ;IHS/OIT/GAB 11.2014 Modified below line and added the next for 2015 Code updates - Patch #26
  1.  ;S $P(@ADEPER@("5-BA"),U,4)="BROKEN APTS (9130)"
  1.  S $P(@ADEPER@("5-BA"),U,4)="BROKEN APTS (9130)"
  1.  S ADEM=$$GETCNT^ADEKRP(ADEYQ,ADE("BA"),"0:125")
  1.  S $P(@ADEPER@("5-BA"),U,3)=$P(ADEM,U,ADEPC)
  1.  ;/IHS/OIT/GAB 1.2015 Added below line for 2015 Code Updates - Patch #26 added Broken appt code 9986
  1.  S $P(@ADEPER@("5.1-BA"),U,4)="BROKEN APTS(9986)"
  1.  S ADEM=$$GETCNT^ADEKRP(ADEYQ,ADE("BA2"),"0:125") ;
  1.  S $P(@ADEPER@("5.1-BA"),U,3)=$P(ADEM,U,ADEPC)   ;  ihs/gab check this.
  1.  ;
  1.  ;Get EXAM Count
  1.  S $P(@ADEPER@("5.2-EXAM"),U,4)="PATIENTS TREATMENT PLANNED"
  1.  S ADEM=$$GETCNT^ADEKRP(ADEYQ,ADE("EXAM IND"),"0:125")
  1.  S $P(@ADEPER@("5.2-EXAM"),U,1)=$P(ADEM,U,ADEPC)
  1.  S ADEM=$$GETCNT^ADEKRP(ADEYQ,ADE("EXAM NON-IND"),"0:125")
  1.  S $P(@ADEPER@("5.2-EXAM"),U,2)=$P(ADEM,U,ADEPC)
  1.  S $P(@ADEPER@("5.2-EXAM"),U,3)=$P(@ADEPER@("5.2-EXAM"),U,1)+$P(@ADEPER@("5.2-EXAM"),U,2)
  1.  ;Get PTC Count
  1.  S $P(@ADEPER@("5.5-PTC"),U,4)="PATIENTS PLANNED TX COMPLETED"
  1.  S ADEM=$$GETCNT^ADEKRP(ADEYQ,ADE("PTC IND"),"0:125")
  1.  S $P(@ADEPER@("5.5-PTC"),U,1)=$P(ADEM,U,ADEPC)
  1.  S ADEM=$$GETCNT^ADEKRP(ADEYQ,ADE("PTC NON-IND"),"0:125")
  1.  S $P(@ADEPER@("5.5-PTC"),U,2)=$P(ADEM,U,ADEPC)
  1.  S $P(@ADEPER@("5.5-PTC"),U,3)=$P(@ADEPER@("5.5-PTC"),U,1)+$P(@ADEPER@("5.5-PTC"),U,2)
  1.  ;
  1.  ;Get DDAYS
  1.  S $P(@ADEPER@("6-DDAY"),U,4)="DENTIST-DAYS"
  1.  S ADEM=$$GETCNT^ADEKRP(ADEYQ,ADE("DDAY"),"0:125")
  1.  S $P(@ADEPER@("6-DDAY"),U,3)=$P(ADEM,U,ADEPC)
  1.  ;
  1.  ;CUM FY PATIENTS 7
  1.  I ADEPC=1 D
  1.  . S $P(@ADEPER@("7-CUM FY"),U,4)="PTS THIS FY - CUMULATIVE"
  1.  . S ADEM=$$GETCNT^ADEKRP(ADEYQ,ADE("FY NEW IND"),"0:125")
  1.  . S $P(@ADEPER@("7-CUM FY"),U,1)=$P(ADEM,U,2)
  1.  . S ADEM=$$GETCNT^ADEKRP(ADEYQ,ADE("FY NEW NON-IND"),"0:125")
  1.  . S $P(@ADEPER@("7-CUM FY"),U,2)=$P(ADEM,U,2)
  1.  . S $P(@ADEPER@("7-CUM FY"),U,3)=$P(@ADEPER@("7-CUM FY"),U,1)+$P(@ADEPER@("7-CUM FY"),U,2)
  1.  ;
  1.  ;FY PATS THIS QTR 8
  1.  I ADEPC=1 D
  1.  . S $P(@ADEPER@("8-QTR FY"),U,4)="PTS THIS FY - CURRENT"
  1.  . S ADEM=$$GETCNT^ADEKRP(ADEYQ,ADE("FY NEW IND"),"0:125")
  1.  . S $P(@ADEPER@("8-QTR FY"),U,1)=$P(ADEM,U,1)
  1.  . S ADEM=$$GETCNT^ADEKRP(ADEYQ,ADE("FY NEW NON-IND"),"0:125")
  1.  . S $P(@ADEPER@("8-QTR FY"),U,2)=$P(ADEM,U,1)
  1.  . S $P(@ADEPER@("8-QTR FY"),U,3)=$P(@ADEPER@("8-QTR FY"),U,1)+$P(@ADEPER@("8-QTR FY"),U,2)
  1.  ;
  1.  Q