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

ADEPX01.m

Go to the documentation of this file.
  1. ADEPX01 ;IHS/HQW/MJL - REPORTS [ 03/24/1999 8:35 AM ]
  1. ;;6.0;ADE;;APRIL 1999;Build 13
  1. ;
  1. CALIF ;CALIFORNIA REPORT
  1. S ^TMP("ADEP",ADEU,0)="CALIFORNIA REPORT "_DT
  1. ;KEY: ^TMP(,,ADELOE)="FV (Indian)^FV (Non-Indian)^RV (Indian)^RV (Non-Indian)^SVC (Indian)^SVC (Non-Indian)^SM (Indian)^SM (Non-Indian)^BA^CA"
  1. ;Put beginning and ending dates in calling option since this
  1. ;code in this routine could be called either interactively or
  1. ;non-interactively by scheduled option
  1. ;
  1. S ADEBD="2801001.00",ADEND=DT_.99
  1. S ADEFV=$O(^AUTTADA("B","0000",0))
  1. S ADERV=$O(^AUTTADA("B","0190",0))
  1. S ADEBA=$O(^AUTTADA("B",9130,0))
  1. S ADECA=$O(^AUTTADA("B",9140,0))
  1. S ADEPTC=$O(^AUTTADA("B",9990,0))
  1. S ADEVS=ADEFV_U_ADERV_U_ADEBA_U_ADECA
  1. S ADEGB="^TMP(""ADEP"",ADEU,ADELOE)"
  1. S ADEX=ADEBD
  1. F S ADEX=$O(^ADEPCD("AC",ADEX)) Q:'+ADEX Q:ADEX>ADEND D
  1. . S ADEY=0
  1. . F S ADEY=$O(^ADEPCD("AC",ADEX,ADEY)) Q:'+ADEY D
  1. . . Q:'$D(^ADEPCD(ADEY,0))
  1. . . S ADENOD=^ADEPCD(ADEY,0)
  1. . . ;INDIAN (1) OR NON-INDIAN (0) ?
  1. . . S ADEIND=1
  1. . . S ADELOE=$P(ADENOD,U,3)
  1. . . Q:$P(ADENOD,U,9)'="d"
  1. . . Q:'$D(^ADEPCD(ADEY,"ADA"))
  1. . . S ADEZ=0
  1. . . F S ADEZ=$O(^ADEPCD(ADEY,"ADA",ADEZ)) Q:'+ADEZ D
  1. . . . S ADENOD=^ADEPCD(ADEY,"ADA",ADEZ,0)
  1. . . . I ADEVS[$P(ADENOD,U) D Q
  1. . . . . I ADECP=ADERV S $P(@ADEGB,U,4-ADEIND)=$P(@ADEGB,U,4-ADEIND)+1 Q
  1. . . . . I ADECP=ADEFV S $P(@ADEGB,U,2-ADEIND)=$P(@ADEGB,U,2-ADEIND)+1 Q
  1. . . . . I ADECP=ADEBA S $P(@ADEGB,U,9)=$P(@ADEGB,U,9)+1 Q
  1. . . . . I ADECP=ADECA S $P(@ADEGB,U,10)=$P(@ADEGB,U,10)+1 Q
  1. . . . I $P(ADENOD,U,5)]"" Q ;Unreportable
  1. . . . ;CHECK LEVEL OF SERVICE, SM
  1. . . . S ADENOD=^AUTTADA(+ADENOD,0)
  1. . . . I $P(ADENOD,U,5)<1!($P(ADENOD,U,5)>8) Q
  1. . . . S $P(@ADEGB,U,6-ADEIND)=$P(@ADEGB,U,6-ADEIND)+$P(ADENOD,U,4)
  1. . . . S $P(@ADEGB,U,8-ADEIND)=$P(@ADEGB,U,8-ADEIND)+1