- 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