ACDRR2CB.m

ACDRR2CB ;IHS/ADC/EDE/KML - BROKE UP ACDRR2C;

 ;;4.1;CHEMICAL DEPENDENCY MIS;;MAY 11, 1998

 ;

INTERV ; EP - PROCESS ALL INTERVENTIONS WITHIN DATE RANGE

 S ACDIDATE=$O(^ACDINTV("B",ACDDTLO),-1)

 F  S ACDIDATE=$O(^ACDINTV("B",ACDIDATE)) Q:ACDIDATE=""!(ACDIDATE>ACDDTHI)  D

 .  S ACDINTV=0

 .  F  S ACDINTV=$O(^ACDINTV("B",ACDIDATE,ACDINTV)) Q:'ACDINTV  D INTERV2

 .  Q

 Q

 ;

INTERV2 ; PROCESS ONE INTERVENTION

 Q:'$D(^ACDINTV(ACDINTV,0))  ;          bad xref

 S ^("COUNT")=$G(^TMP("ACDRR2",ACDJOB,ACDBT,"VISIT TYPE","INTV","COUNT"))+1

 S X=^ACDINTV(ACDINTV,0)

 S ACDHRS=$P(X,U,26)

 I 'ACDHRS S ^("HOURS NR")=$G(^TMP("ACDRR2",ACDJOB,ACDBT,"VISIT TYPE","INTV","HOURS NR"))+1 Q

 S ^("HOURS")=$G(^TMP("ACDRR2",ACDJOB,ACDBT,"VISIT TYPE","INTV","HOURS"))+ACDHRS

 S ^("HOURS CNT")=$G(^TMP("ACDRR2",ACDJOB,ACDBT,"VISIT TYPE","INTV","HOURS CNT"))+1

 S ACDINTVM=0

 F  S ACDINTVM=$O(^ACDINTV(ACDINTV,2,ACDINTVM)) Q:'ACDINTVM  S X=^(ACDINTVM,0) D INTVM

 Q

 ;

INTVM ; PROCESS ONE INTERVENTIONS MEMEBER (PROVIDER)

 S ACDWPROV=$P(X,U) ;                      provider

 ;D PFTV^XBPFTV(6,ACDWPROV,.ACDWPROV) ; ** ^DIC(6, **

 S ACDWPROV=$P($G(^VA(200,ACDWPROV,0)),U)

 S:ACDWPROV="" ACDWPROV=$P(X,U)

 S ^("COUNT")=$G(^TMP("ACDRR2",ACDJOB,ACDBT,"PROV",ACDWPROV,"VT","INTV","COUNT"))+1

 S ^("HOURS")=$G(^TMP("ACDRR2",ACDJOB,ACDBT,"PROV",ACDWPROV,"VT","INTV","HOURS"))+ACDHRS

 S ^("HOURS CNT")=$G(^TMP("ACDRR2",ACDJOB,ACDBT,"PROV",ACDWPROV,"VT","INTV","HOURS CNT"))+1

 Q

ACDRR2CB  ;IHS/ADC/EDE/KML - BROKE UP ACDRR2C;

 +1       ;;4.1;CHEMICAL DEPENDENCY MIS;;MAY 11, 1998

 +2       ;

INTERV    ; EP - PROCESS ALL INTERVENTIONS WITHIN DATE RANGE

 +1        SET ACDIDATE=$ORDER(^ACDINTV("B",ACDDTLO),-1)

 +2        FOR 

               SET ACDIDATE=$ORDER(^ACDINTV("B",ACDIDATE))

               IF ACDIDATE=""!(ACDIDATE>ACDDTHI)

                   QUIT 

               Begin DoDot:1

 +3                SET ACDINTV=0

 +4                FOR 

                       SET ACDINTV=$ORDER(^ACDINTV("B",ACDIDATE,ACDINTV))

                       IF 'ACDINTV

                           QUIT 

                       DO INTERV2

 +5                QUIT 

               End DoDot:1

 +6        QUIT 

 +7       ;

INTERV2   ; PROCESS ONE INTERVENTION

 +1       ;          bad xref

           IF '$DATA(^ACDINTV(ACDINTV,0))

               QUIT 

 +2        SET ^("COUNT")=$GET(^TMP("ACDRR2",ACDJOB,ACDBT,"VISIT TYPE","INTV","COUNT"))+1

 +3        SET X=^ACDINTV(ACDINTV,0)

 +4        SET ACDHRS=$PIECE(X,U,26)

 +5        IF 'ACDHRS

               SET ^("HOURS NR")=$GET(^TMP("ACDRR2",ACDJOB,ACDBT,"VISIT TYPE","INTV","HOURS NR"))+1

               QUIT 

 +6        SET ^("HOURS")=$GET(^TMP("ACDRR2",ACDJOB,ACDBT,"VISIT TYPE","INTV","HOURS"))+ACDHRS

 +7        SET ^("HOURS CNT")=$GET(^TMP("ACDRR2",ACDJOB,ACDBT,"VISIT TYPE","INTV","HOURS CNT"))+1

 +8        SET ACDINTVM=0

 +9        FOR 

               SET ACDINTVM=$ORDER(^ACDINTV(ACDINTV,2,ACDINTVM))

               IF 'ACDINTVM

                   QUIT 

               SET X=^(ACDINTVM,0)

               DO INTVM

 +10       QUIT 

 +11      ;

INTVM     ; PROCESS ONE INTERVENTIONS MEMEBER (PROVIDER)

 +1       ;                      provider

           SET ACDWPROV=$PIECE(X,U)

 +2       ;D PFTV^XBPFTV(6,ACDWPROV,.ACDWPROV) ; ** ^DIC(6, **

 +3        SET ACDWPROV=$PIECE($GET(^VA(200,ACDWPROV,0)),U)

 +4        IF ACDWPROV=""

               SET ACDWPROV=$PIECE(X,U)

 +5        SET ^("COUNT")=$GET(^TMP("ACDRR2",ACDJOB,ACDBT,"PROV",ACDWPROV,"VT","INTV","COUNT"))+1

 +6        SET ^("HOURS")=$GET(^TMP("ACDRR2",ACDJOB,ACDBT,"PROV",ACDWPROV,"VT","INTV","HOURS"))+ACDHRS

 +7        SET ^("HOURS CNT")=$GET(^TMP("ACDRR2",ACDJOB,ACDBT,"PROV",ACDWPROV,"VT","INTV","HOURS CNT"))+1

 +8        QUIT