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

ADEKNT3.m

Go to the documentation of this file. 
  1. ADEKNT3 ; IHS/HQT/MJL - COMPILE DENTAL REPORTS ;  [ 03/24/1999   9:04 AM ]
  1.  ;;6.0;ADE;;APRIL 1999
  1. FILE ;EP
  1.  ;For each objective-agegroup in ^TMP($J,"CTR",
  1.  ; Create unique entry by concatenating YEAR.QUARTER.OBJECTIVE.AGEGROUP
  1.  ; Test whether an entry by that name already exists
  1.  ;  If not, create it
  1.  ; Populate the entry with values from ^TMP($J,"CTR",
  1.  ;
  1.  N ADENOD,ADEIEN,ADEGRP,ADE01
  1.  L +^ADEKNT:$S($D(DTIME):DTIME,1:300) Q:'$T
  1.  S ADEIEN=0
  1.  F  S ADEIEN=$O(^TMP($J,"CTR",ADEIEN)) Q:'+ADEIEN  D
  1.  . S ADEGRP=0
  1.  . F  S ADEGRP=$O(^TMP($J,"CTR",ADEIEN,ADEGRP)) Q:ADEGRP'?1N.E  D
  1.  . . D ENTRY(ADEIEN,ADEGRP,"")
  1.  . . S ADELOE=""
  1.  . . F  S ADELOE=$O(^TMP($J,"CTR",ADEIEN,ADEGRP,ADELOE)) Q:'+ADELOE  D
  1.  . . . D ENTRY(ADEIEN,ADEGRP,ADELOE)
  1.  . . . Q
  1.  . . Q
  1.  . Q
  1.  L -^ADEKNT:DTIME
  1.  Q
  1.  ;
  1. ENTRY(ADEIEN,ADEGRP,ADELOE)  ;EP
  1.  N ADE01,ADENOD
  1.  S ADE01=$P(ADEPER,U)_"."_ADEIEN_"."_ADEGRP
  1.  I +ADELOE D
  1.  . S ADE01=ADE01_"."_ADELOE
  1.  . S ADENOD=^TMP($J,"CTR",ADEIEN,ADEGRP,ADELOE)
  1.  E  S ADENOD=^TMP($J,"CTR",ADEIEN,ADEGRP)
  1.  I '$D(^ADEKNT("B",ADE01)) D
  1.  . S DIC="^ADEKNT("
  1.  . S DIC(0)="LZ"
  1.  . S X=ADE01
  1.  . K DD,DO
  1.  . D FILE^DICN
  1.  S DA=$O(^ADEKNT("B",ADE01,0))
  1.  ;FHL 9/9/98 B:'+DA  ;***remove after testing
  1.  S ADEYR=$P(ADE01,".")
  1.  ;beginning Y2K fix
  1.  ;S ADEYR=$S(ADEYR<81:20,1:19)_ADEYR ;OK, So I'm optimistic!
  1.  ;end Y2K fix block
  1.  S DR=".02///"_$P(ADENOD,U)_";.03///"_$P(ADENOD,U,2)
  1.  S DR=DR_";.04///"_$P(ADENOD,U,3)_";.05///"_ADEYR
  1.  S DR=DR_";.06///"_$P(ADE01,".",2)_";.07///`"_ADEIEN
  1.  S DR=DR_";.09///"_$P(ADEGRP,":",2)
  1.  S:+ADELOE DR=DR_";.11///`"_ADELOE
  1.  S DR=DR_";.08///"_$P(ADEGRP,":")
  1.  S DIE="^ADEKNT("
  1.  D ^DIE
  1.  Q
  1.  ;
  1. BULL(ADEBUL)       ;EP - Sends Bulletin
  1.  ; ADEBUL=1 Complete
  1.  ; ADEBUL=0 Abend
  1.  ;
  1.  S XMB=$S(ADEBUL:"ADEK-COMPLETE",1:"ADEK-ABEND")
  1.  S XMDUZ="DENTAL PACKAGE"
  1.  S XMB(1)="UNKNOWN"
  1.  S:$D(ADEYQ) XMB(1)=+ADEYQ
  1.  I ADEBUL D
  1.  . S XMB(2)=$$MIN(ADE("STARTTIME"),$H)
  1.  . S XMB(2)=$S(+XMB(2):+XMB(2)_" Hours",1:"")_$S(+$P(XMB(2),U,2):$P(XMB(2),U,2)_" Minutes",1:"")
  1.  D ^XMB
  1.  Q
  1.  ;
  1. ERR ;EP - Error trap
  1.  ;Log error info
  1.  I $D(^%ZOSF("ERRTN")) D @^%ZOSF("ERRTN")
  1.  ;Send error bulletin
  1.  D BULL(0)
  1.  ;go end
  1.  G END^ADEKNT
  1.  ;
  1. MIN(ADEX1,ADEX2)   ;EP
  1.  ;Returns number of HOURS^MINUTES between ADEX1 and ADEX2
  1.  ;where ADEX1 < ADEX2 and both are in $H format
  1.  N ADEMIN
  1.  ;
  1.  I $P(ADEX1,",")=$P(ADEX2,",") D
  1.  . S ADEMIN=$P(ADEX2,",",2)-$P(ADEX1,",",2)
  1.  ;
  1.  E  D
  1.  . S ADEMIN=86400-$P(ADEX1,",",2)
  1.  . S ADEMIN=ADEMIN+$P(ADEX2,",",2)
  1.  . S ADEMIN=ADEMIN+(86400*($P(ADEX2,",")-$P(ADEX1,",")-1))
  1.  ;
  1.  S ADEMIN=$FN(ADEMIN/60,"",0)
  1.  S ADEMIN=(ADEMIN\60)_U_(ADEMIN#60)
  1.  Q ADEMIN
  1.  ;
  1. ADDMIN(ADENOW,ADEMIN)        ;EP
  1.  ;Returns $H value resulting from addition of
  1.  ;ADEMIN minutes to ADENOW where ADENOW is a time
  1.  ;in $H format.
  1.  ;
  1.  N ADEH,ADEM,ADEP
  1.  S ADEMIN=ADEMIN*60
  1.  S ADEH=$P(ADENOW,",")
  1.  S ADEM=$P(ADENOW,",",2)
  1.  I (ADEM+ADEMIN)'>86400 Q ADEH_","_(ADEM+ADEMIN)
  1.  S ADEP=ADEM+ADEMIN
  1.  S ADEH=ADEH+(ADEP\86400)
  1.  S ADEM=(ADEP#86400)
  1.  Q ADEH_","_ADEM