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

ADEKNT.m

Go to the documentation of this file. 
  1. ADEKNT ; IHS/HQT/MJL - COMPILE DENTAL REPORTS ;  [ 03/24/1999   9:04 AM ]
  1.  ;;6.0;ADE;**23**;JUN 6, 2011
  1.  ;
  1.  ; TODO: Add facility capability to reports
  1.  ;Entry points:
  1.  ;  ADEKNT - prompt year,quarter & do all objectives.
  1.  ;  EN(Objective)- prompt year.quarter, do objectives in parameter
  1.  ;  ZTM - Tasked option ADEK-QUARTER
  1.  ;  KNS - Called by ADEKNS installation routine
  1.  ;
  1.  N ADEYQ,ADESELOB
  1. TOP ;
  1.  S ADEYQ=$$ASKYQ^ADEKNT4()
  1.  G:'ADEYQ END
  1.  ;Objective(s) to be processed are stored in ;-delimited string ADESELOB
  1.  ;which may also contain "ALL", "DATE", or "USER"
  1.  S:'$D(ADESELOB) ADESELOB="ALL"
  1.  S ZTRTN="START^ADEKNT",ZTDESC="DENTAL STATS "_ADEYQ,ZTIO="",ZTSAVE("ADEYQ")="",ZTSAVE("ADESELOB")="" D ^%ZTLOAD G END ;***TODO: Uncomment after test
  1.  G START
  1.  ;
  1. ZTM ;EP - Entry point for tasked option ADEK-QUARTER
  1.  N ADEYQ,ADESELOB
  1.  S ADEYQ=$$QTR^ADEKNT5(DT)
  1.  S ADESELOB="ALL"
  1.  G START
  1.  ;
  1. KNS(ADEYQ,ADESELOB) ;EP - Called by ADEKNS installation routine
  1.  G START
  1.  ;
  1. START ;EP
  1.  N ADEBDI,ADEEDI,ADEDFN,ADEV,ADEVD,ADEVDFN,ADEUP,ADEDUP
  1.  N ADECLIN,ADEFAC
  1.  N ADEPER,ADE3BD,ADE1BD,ADEED,ADE3BDI,ADE1BDI,ADEQBDI,ADEEDI
  1.  N ADECTR,ADEOBJ,ADEDOB,ADEHXC,ADEHXO,ADEIEN,ADEIND,ADELOE,ADEOGRP
  1.  N ADEPAT,ADEQBD,ADEYR,ADE
  1.  N DR,DIE,DIC
  1.  K ^TMP($J,"CTR")
  1.  ;
  1. S2 ;
  1.  ;Get Start time
  1.  S ADE("STARTTIME")=$H
  1.  ;Set error trap to send mailman message that count routine abended
  1.  I $D(^%ZOSF("TRAP")) S X="ERR^ADEKNT3",@^%ZOSF("TRAP")
  1.  ;I $D(^%ZOSF("MAXSIZ")) S X=255 X ^%ZOSF("MAXSIZ")
  1.  ;
  1.  ;INIT:
  1.  S ADEPER=$$PERIOD^ADEKNT5($P(ADEYQ,"."),+$P(ADEYQ,".",2))
  1.  S ADE3BD=$P(ADEPER,U,3)
  1.  S ADE1BD=$P(ADEPER,U,4)
  1.  S ADEQBD=$P(ADEPER,U,5)
  1.  S ADEED=$P(ADEPER,U,2)
  1.  ;
  1.  ;Set inverse beginning and ending dates
  1.  S ADE3BDI=9999999-ADE3BD
  1.  S ADE1BDI=9999999-ADE1BD
  1.  S ADEQBDI=9999999-ADEQBD
  1.  S ADEEDI=9999999-ADEED
  1.  ;
  1.  ;Get ^-delimited dental facility IENs in ADEFAC
  1.  S ADEFAC=$$LOADFAC^ADEKRP()
  1.  ;
  1.  ;Initialize counter array ^TMP($J,"CTR", for all objectives in ^ADEKOB
  1.  D ARRAY^ADEKNT1(ADESELOB)
  1.  ;
  1.  ;B  ;Break here to examine initial ^TMP($J,"CTR",
  1.  ;
  1. PROC ;$O Thru ^AUPNPAT
  1.  S ADEDFN=0
  1.  ;This is the production line:
  1.  I ADESELOB'="DATE" F  S ADEDFN=$O(^AUPNPAT(ADEDFN)) Q:+ADEDFN'=ADEDFN  D
  1.  . ;I ADESELOB'="DATE" F ADEDFN=1,2 D  ;***COMMENT AFTER TEST
  1.  . ;This is the test line:
  1.  . ;Get DOB
  1.  . Q:'$D(^AUPNPAT(ADEDFN,0))
  1.  . Q:'$D(^DPT(ADEDFN,0))
  1.  . S ADEDOB=$P(^DPT(ADEDFN,0),U,3)
  1.  . Q:'+ADEDOB  ;Quit if no DOB
  1.  . Q:ADEDOB>ADEED  ;Quit if born after enddate
  1.  . I ($E(DT,1,3)-$E(ADEDOB,1,3))>123 Q  ;Age > 123 -- DOB Wrong
  1.  . ;Set objective age group array ADEOBJ(
  1.  . D ADEOBJ(ADEDOB)
  1.  . ;Indian or Non-Indian (ADEIND)
  1.  . S ADEIND=$$INDIAN(ADEDFN)
  1.  . ;Increment User Counters
  1.  . D:ADESELOB["ALL"!(ADESELOB["USER") USER
  1.  . ;Increment Objective Counters
  1.  . D OBJECT^ADEKNT2 ;***Uncomment after test of visit counters
  1.  ;
  1.  ;Increment daily & visit Counters
  1.  D:ADESELOB["ALL"!(ADESELOB["DATE") DATE^ADEKNT1
  1.  ;
  1.  ;Q  ;Break here to examine finished ^TMP($J,"CTR",
  1.  ;Update DENTAL OBJECTIVE COUNT file
  1.  D FILE^ADEKNT3
  1.  ;Send mail message
  1.  D BULL^ADEKNT3(1)
  1.  ;California stats
  1.  D CFBULL^ADEKNT6(+ADEYQ)
  1.  ;Processing time in minutes
  1.  S ADE("PROC_TIME")=$$MIN^ADEKNT3(ADE("STARTTIME"),$H)
  1.  S ^ADEUTL("ADEKNT_TIME")=(60*$P(ADE("PROC_TIME"),U))+($P(ADE("PROC_TIME"),U,2))+60
  1.  ;
  1. END ;EP
  1.  ;All local variables are NEW; none have to be KILLed
  1.  Q
  1.  ;
  1. USERDONE()         ;Return 1 if all facilities have a visit count
  1.  N ADEDON,J
  1.  S ADEDON=1
  1.  Q:'ADEGOTV 0
  1.  F J=1:1:$L(ADEFAC,U) D  Q:'ADEDON
  1.  . I '+$G(ADEGOTV($P(ADEFAC,U,J))) S ADEDON=0
  1.  Q ADEDON
  1.  ;
  1. USER ;$O Thru ^AUPNVSIT entries for patient ADEDFN
  1.  N ADEGOTV
  1.  S ADEGOTV=0
  1.  S ADEV=ADEEDI-1
  1.  F  S ADEV=$O(^AUPNVSIT("AA",ADEDFN,ADEV)) Q:ADEV'=+ADEV  S ADEVD=$P(ADEV,".") Q:ADEVD>ADE3BDI  D  Q:$$USERDONE()
  1.  . S ADEVDFN=0
  1.  . F  S ADEVDFN=$O(^AUPNVSIT("AA",ADEDFN,ADEV,ADEVDFN)) Q:ADEVDFN'=+ADEVDFN  D  Q:$$USERDONE()
  1.  . . ;If pt had visit S ADEGOTV=1
  1.  . . Q:'$D(^AUPNVSIT(ADEVDFN,0))
  1.  . . N ADENOD
  1.  . . S ADENOD=^AUPNVSIT(ADEVDFN,0)
  1.  . . Q:$P(ADENOD,U,11)  ;Delete flag
  1.  . . Q:'$P(ADENOD,U,9)  ;Dependent entries
  1.  . . Q:"DXECT"[$P(ADENOD,U,7)  ;Service Category
  1.  . . Q:'$D(^AUPNVPOV("AD",ADEVDFN))  ;No POV
  1.  . . Q:'$D(^AUPNVPRV("AD",ADEVDFN))  ;No Provider
  1.  . . S ADELOE=$P(ADENOD,U,6) ;Location
  1.  . . ;It's a legit visit so if ADEGOTV hasn't already been set
  1.  . . ;then set it to 1 and increment the med visit counters
  1.  . . I 'ADEGOTV D  ;All Facilities
  1.  . . . S ADEGOTV=1
  1.  . . . ;F ADEIEN="MEDICAL USER (ALL)",$S(ADEIND=1:"MEDICAL USER (INDIAN)",1:"MEDICAL USER (NON-INDIAN)") D
  1.  . . . F ADEIEN=3,$S(ADEIND=1:1,1:2) D
  1.  . . . . Q:$G(^TMP($J,"CTR",ADEIEN,ADEOBJ(ADEIEN)))=""  D
  1.  . . . . . F K=$S(ADEVD'>ADEQBDI:1,ADEVD'>ADE1BDI:2,1:3):1:3 S $P(^TMP($J,"CTR",ADEIEN,ADEOBJ(ADEIEN)),U,K)=$P(^TMP($J,"CTR",ADEIEN,ADEOBJ(ADEIEN)),U,K)+1
  1.  . . . Q
  1.  . . I '+$G(ADEGOTV(ADELOE)) D
  1.  . . . S ADEGOTV(ADELOE)=1
  1.  . . . F ADEIEN=3,$S(ADEIND=1:1,1:2) D
  1.  . . . . Q:$G(^TMP($J,"CTR",ADEIEN,ADEOBJ(ADEIEN),ADELOE))=""  D
  1.  . . . . . F K=$S(ADEVD'>ADEQBDI:1,ADEVD'>ADE1BDI:2,1:3):1:3 S $P(^TMP($J,"CTR",ADEIEN,ADEOBJ(ADEIEN),ADELOE),U,K)=$P(^TMP($J,"CTR",ADEIEN,ADEOBJ(ADEIEN),ADELOE),U,K)+1
  1.  . . Q
  1.  . Q
  1.  Q
  1.  ;
  1. INDIAN(ADEDFN) ;EP
  1.  ;Return 1 if Indian or if NO TRIBE at all
  1.  ;Else return 2 (NON-Indian)
  1.  ;Conforms to logic in APCLACC2
  1.  N ADEIND
  1.  I '$D(^AUPNPAT(ADEDFN,11)) Q 1
  1.  S ADEIND=$P(^AUPNPAT(ADEDFN,11),U,8)
  1.  I ADEIND="" Q 1
  1.  I '$D(^AUTTTRI(ADEIND,0)) Q 1
  1.  S ADEIND=$P(^AUTTTRI(ADEIND,0),U,2)
  1.  I +ADEIND,ADEIND<969 Q 1
  1.  I ADEIND=997 Q 1
  1.  Q 2
  1.  ;
  1. ADEOBJ(ADEDOB)     ;EP
  1.  ;$O thru ^TMP($J,"CTR", and
  1.  ;Set ADEOBJ( array based on ADEDOB
  1.  N ADEIEN
  1.  S ADEIEN=0 K ADEOBJ
  1.  F  S ADEIEN=$O(^TMP($J,"CTR",ADEIEN)) Q:'+ADEIEN  D
  1.  . S ADEOGRP=0
  1.  . F  S ADEOGRP=$O(^TMP($J,"CTR",ADEIEN,ADEOGRP)) Q:ADEOGRP'?1N.E  D  Q:$D(ADEOBJ(ADEIEN))
  1.  . . Q:ADEDOB<$P(^TMP($J,"CTR",ADEIEN,ADEOGRP),U,4)
  1.  . . Q:ADEDOB>$P(^TMP($J,"CTR",ADEIEN,ADEOGRP),U,5)
  1.  . . S ADEOBJ(ADEIEN)=ADEOGRP
  1.  . . Q
  1.  . Q
  1.  Q
  1.  ;
  1. EN(ADESELOB)       ;EP
  1.  ;Enter here with ADESELOB defined
  1.  ;
  1.  N ADEYQ
  1.  G TOP