ADEPX01.m

ADEPX01 ;IHS/HQW/MJL - REPORTS  [ 03/24/1999   8:35 AM ]

 ;;6.0;ADE;;APRIL 1999;Build 13

 ;

CALIF ;CALIFORNIA REPORT

 S ^TMP("ADEP",ADEU,0)="CALIFORNIA REPORT "_DT

 ;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"

 ;Put beginning and ending dates in calling option since this

 ;code in this routine could be called either interactively or

 ;non-interactively by scheduled option

 ;

 S ADEBD="2801001.00",ADEND=DT_.99

 S ADEFV=$O(^AUTTADA("B","0000",0))

 S ADERV=$O(^AUTTADA("B","0190",0))

 S ADEBA=$O(^AUTTADA("B",9130,0))

 S ADECA=$O(^AUTTADA("B",9140,0))

 S ADEPTC=$O(^AUTTADA("B",9990,0))

 S ADEVS=ADEFV_U_ADERV_U_ADEBA_U_ADECA

 S ADEGB="^TMP(""ADEP"",ADEU,ADELOE)"

 S ADEX=ADEBD

 F  S ADEX=$O(^ADEPCD("AC",ADEX)) Q:'+ADEX  Q:ADEX>ADEND  D

 . S ADEY=0

 . F  S ADEY=$O(^ADEPCD("AC",ADEX,ADEY)) Q:'+ADEY  D

 . . Q:'$D(^ADEPCD(ADEY,0))

 . . S ADENOD=^ADEPCD(ADEY,0)

 . . ;INDIAN (1) OR NON-INDIAN (0) ?

 . . S ADEIND=1

 . . S ADELOE=$P(ADENOD,U,3)

 . . Q:$P(ADENOD,U,9)'="d"

 . . Q:'$D(^ADEPCD(ADEY,"ADA"))

 . . S ADEZ=0

 . . F  S ADEZ=$O(^ADEPCD(ADEY,"ADA",ADEZ)) Q:'+ADEZ  D

 . . . S ADENOD=^ADEPCD(ADEY,"ADA",ADEZ,0)

 . . . I ADEVS[$P(ADENOD,U) D  Q

 . . . . I ADECP=ADERV S $P(@ADEGB,U,4-ADEIND)=$P(@ADEGB,U,4-ADEIND)+1 Q

 . . . . I ADECP=ADEFV S $P(@ADEGB,U,2-ADEIND)=$P(@ADEGB,U,2-ADEIND)+1 Q

 . . . . I ADECP=ADEBA S $P(@ADEGB,U,9)=$P(@ADEGB,U,9)+1 Q

 . . . . I ADECP=ADECA S $P(@ADEGB,U,10)=$P(@ADEGB,U,10)+1 Q

 . . . I $P(ADENOD,U,5)]"" Q  ;Unreportable

 . . . ;CHECK LEVEL OF SERVICE, SM

 . . . S ADENOD=^AUTTADA(+ADENOD,0)

 . . . I $P(ADENOD,U,5)<1!($P(ADENOD,U,5)>8) Q

 . . . S $P(@ADEGB,U,6-ADEIND)=$P(@ADEGB,U,6-ADEIND)+$P(ADENOD,U,4)

 . . . S $P(@ADEGB,U,8-ADEIND)=$P(@ADEGB,U,8-ADEIND)+1

ADEPX01   ;IHS/HQW/MJL - REPORTS  [ 03/24/1999   8:35 AM ]

 +1       ;;6.0;ADE;;APRIL 1999;Build 13

 +2       ;

CALIF     ;CALIFORNIA REPORT

 +1        SET ^TMP("ADEP",ADEU,0)="CALIFORNIA REPORT "_DT

 +2       ;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"

 +3       ;Put beginning and ending dates in calling option since this

 +4       ;code in this routine could be called either interactively or

 +5       ;non-interactively by scheduled option

 +6       ;

 +7        SET ADEBD="2801001.00"

           SET ADEND=DT_.99

 +8        SET ADEFV=$ORDER(^AUTTADA("B","0000",0))

 +9        SET ADERV=$ORDER(^AUTTADA("B","0190",0))

 +10       SET ADEBA=$ORDER(^AUTTADA("B",9130,0))

 +11       SET ADECA=$ORDER(^AUTTADA("B",9140,0))

 +12       SET ADEPTC=$ORDER(^AUTTADA("B",9990,0))

 +13       SET ADEVS=ADEFV_U_ADERV_U_ADEBA_U_ADECA

 +14       SET ADEGB="^TMP(""ADEP"",ADEU,ADELOE)"

 +15       SET ADEX=ADEBD

 +16       FOR 

               SET ADEX=$ORDER(^ADEPCD("AC",ADEX))

               IF '+ADEX

                   QUIT 

               IF ADEX>ADEND

                   QUIT 

               Begin DoDot:1

 +17               SET ADEY=0

 +18               FOR 

                       SET ADEY=$ORDER(^ADEPCD("AC",ADEX,ADEY))

                       IF '+ADEY

                           QUIT 

                       Begin DoDot:2

 +19                       IF '$DATA(^ADEPCD(ADEY,0))

                               QUIT 

 +20                       SET ADENOD=^ADEPCD(ADEY,0)

 +21      ;INDIAN (1) OR NON-INDIAN (0) ?

 +22                       SET ADEIND=1

 +23                       SET ADELOE=$PIECE(ADENOD,U,3)

 +24                       IF $PIECE(ADENOD,U,9)'="d"

                               QUIT 

 +25                       IF '$DATA(^ADEPCD(ADEY,"ADA"))

                               QUIT 

 +26                       SET ADEZ=0

 +27                       FOR 

                               SET ADEZ=$ORDER(^ADEPCD(ADEY,"ADA",ADEZ))

                               IF '+ADEZ

                                   QUIT 

                               Begin DoDot:3

 +28                               SET ADENOD=^ADEPCD(ADEY,"ADA",ADEZ,0)

 +29                               IF ADEVS[$PIECE(ADENOD,U)

                                       Begin DoDot:4

 +30                                       IF ADECP=ADERV

                                               SET $PIECE(@ADEGB,U,4-ADEIND)=$PIECE(@ADEGB,U,4-ADEIND)+1

                                               QUIT 

 +31                                       IF ADECP=ADEFV

                                               SET $PIECE(@ADEGB,U,2-ADEIND)=$PIECE(@ADEGB,U,2-ADEIND)+1

                                               QUIT 

 +32                                       IF ADECP=ADEBA

                                               SET $PIECE(@ADEGB,U,9)=$PIECE(@ADEGB,U,9)+1

                                               QUIT 

 +33                                       IF ADECP=ADECA

                                               SET $PIECE(@ADEGB,U,10)=$PIECE(@ADEGB,U,10)+1

                                               QUIT 

                                       End DoDot:4

                                       QUIT 

 +34      ;Unreportable

                                   IF $PIECE(ADENOD,U,5)]""

                                       QUIT 

 +35      ;CHECK LEVEL OF SERVICE, SM

 +36                               SET ADENOD=^AUTTADA(+ADENOD,0)

 +37                               IF $PIECE(ADENOD,U,5)<1!($PIECE(ADENOD,U,5)>8)

                                       QUIT 

 +38                               SET $PIECE(@ADEGB,U,6-ADEIND)=$PIECE(@ADEGB,U,6-ADEIND)+$PIECE(ADENOD,U,4)

 +39                               SET $PIECE(@ADEGB,U,8-ADEIND)=$PIECE(@ADEGB,U,8-ADEIND)+1

                               End DoDot:3

                       End DoDot:2

               End DoDot:1