ACDRR2C ; IHS/ADC/EDE/KML - GATHER WORKLOAD DATA ;
;;4.1;CHEMICAL DEPENDENCY MIS;;MAY 11, 1998
;
; This routine processes each visit within date range, gathers
; provider workload data, then processes other file entries
; by the same date range.
;
START ;
D INIT
D VISITS
D COMPUTE1
D PREVENT
D INTERV
D EOJ
Q
;
INIT ;
S (ACDBT,ACDBTH)=$H,ACDJOB=$J
K ^TMP("ACDRR2",$J)
Q
;
VISITS ; PROCESS ALL VISITS WITHIN DATE RANGE
S ACDVDATE=$O(^ACDVIS("B",ACDDTLO),-1)
F S ACDVDATE=$O(^ACDVIS("B",ACDVDATE)) Q:ACDVDATE=""!(ACDVDATE>ACDDTHI) D
. S ACDVIEN=0
. F S ACDVIEN=$O(^ACDVIS("B",ACDVDATE,ACDVIEN)) Q:'ACDVIEN D VISIT
. Q
Q
;
VISIT ; PROCESS ONE VISIT
Q:'$D(^ACDVIS(ACDVIEN,0)) ; bad xref
Q:$G(^ACDVIS(ACDVIEN,"BWP"))'=ACDPGM ;not from current program
S X=^ACDVIS(ACDVIEN,0)
S ACDTC=$P(X,U,4) ; type contact
S Y=$P(X,U,3) ; primary provider
;D PFTV^XBPFTV(6,Y,.ACDPPROV) ; ** ^DIC(6, **
S ACDPPROV=$P($G(^VA(200,Y,0)),U)
S:ACDPPROV="" ACDPPROV=Y
S ACDPIEN=$P(X,U,5) ; patient ien
I ACDPIEN D
. S ^TMP("ACDRR2",ACDJOB,ACDBT,"PATIENT",ACDPIEN)=""
. S ^TMP("ACDRR2",ACDJOB,ACDBT,"PP",ACDPPROV,ACDPIEN)=""
. Q
D @("PRC"_ACDTC) ; process iif/td
Q
;
PRCIN ; INITIAL
D PRCIIF
Q
;
PRCRE ; REOPEN
D PRCIIF
Q
;
PRCFU ; FOLLOWUP
D PRCIIF
Q
;
PRCIR ; INFO/REFERRAL
D PRCIIF
Q
;
PRCOT ; CRISIS BRIEF
D PRCIIF
Q
;
PRCIIF ; PROCESS IIF ENTRY
S ACDIIEN=$O(^ACDIIF("C",ACDVIEN,0))
Q:'ACDIIEN ; no iif entry
Q:'$D(^ACDIIF(ACDIIEN,0)) ; bad xref
S ^("COUNT")=$G(^TMP("ACDRR2",ACDJOB,ACDBT,"PROV",ACDPPROV,"VT",ACDTC,"COUNT"))+1
S ^("COUNT")=$G(^TMP("ACDRR2",ACDJOB,ACDBT,"VISIT TYPE",ACDTC,"COUNT"))+1
S X=^ACDIIF(ACDIIEN,0)
S ACDHRS=$P(X,U,6)
I 'ACDHRS S ^("HOURS NR")=$G(^TMP("ACDRR2",ACDJOB,ACDBT,"PROV",ACDPPROV,"VT",ACDTC,"HOURS NR"))+1,^("HOURS NR")=$G(^TMP("ACDRR2",ACDJOB,ACDBT,"VISIT TYPE",ACDTC,"HOURS NR"))+1 Q
S ^("HOURS")=$G(^TMP("ACDRR2",ACDJOB,ACDBT,"PROV",ACDPPROV,"VT",ACDTC,"HOURS"))+ACDHRS,^("HOURS")=$G(^TMP("ACDRR2",ACDJOB,ACDBT,"VISIT TYPE",ACDTC,"HOURS"))+ACDHRS
S ^("HOURS CNT")=$G(^TMP("ACDRR2",ACDJOB,ACDBT,"PROV",ACDPPROV,"VT",ACDTC,"HOURS CNT"))+1,^("HOURS CNT")=$G(^TMP("ACDRR2",ACDJOB,ACDBT,"VISIT TYPE",ACDTC,"HOURS CNT"))+1
Q
;
PRCTD ; TRANS/DISC/CLOSE ENTRY
S ACDTIEN=$O(^ACDTDC("C",ACDVIEN,0))
Q:'ACDTIEN ; no tdc entry
Q:'$D(^ACDTDC(ACDTIEN,0)) ; bad xref
S ^("COUNT")=$G(^TMP("ACDRR2",ACDJOB,ACDBT,"PROV",ACDPPROV,"VT",ACDTC,"COUNT"))+1
S X=^ACDTDC(ACDTIEN,0)
S ACDHRS=$P(X,U,29)
I 'ACDHRS S ^("HOURS NR")=$G(^TMP("ACDRR2",ACDJOB,ACDBT,"PROV",ACDPPROV,"VT",ACDTC,"HOURS NR"))+1,^("HOURS NR")=$G(^TMP("ACDRR2",ACDJOB,ACDBT,"VISIT TYPE",ACDTC,"HOURS NR"))+1 Q
S ^("HOURS")=$G(^TMP("ACDRR2",ACDJOB,ACDBT,"PROV",ACDPPROV,"VT",ACDTC,"HOURS"))+ACDHRS,^("HOURS")=$G(^TMP("ACDRR2",ACDJOB,ACDBT,"VISIT TYPE",ACDTC,"HOURS"))+ACDHRS
S ^("HOURS CNT")=$G(^TMP("ACDRR2",ACDJOB,ACDBT,"PROV",ACDPPROV,"VT",ACDTC,"HOURS CNT"))+1,^("HOURS CNT")=$G(^TMP("ACDRR2",ACDJOB,ACDBT,"VISIT TYPE",ACDTC,"HOURS CNT"))+1
Q
;
PRCCS ; CLIENT SERVICES
S ACDCSIEN=0
F S ACDCSIEN=$O(^ACDCS("C",ACDVIEN,ACDCSIEN)) Q:'ACDCSIEN I $D(^ACDCS(ACDCSIEN,0)) S X=^(0) D
. S ^("COUNT")=$G(^TMP("ACDRR2",ACDJOB,ACDBT,"VISIT TYPE",ACDTC,"COUNT"))+1
. S ACDCS=$P(X,U,2)
. S ACDHRS=$P(X,U,4)
. I 'ACDHRS S ^("HOURS NR")=$G(^TMP("ACDRR2",ACDJOB,ACDBT,"VISIT TYPE",ACDTC,"HOURS NR"))+1 Q
. S ^("HOURS")=$G(^TMP("ACDRR2",ACDJOB,ACDBT,"VISIT TYPE",ACDTC,"HOURS"))+ACDHRS
. S ^("HOURS CNT")=$G(^TMP("ACDRR2",ACDJOB,ACDBT,"VISIT TYPE",ACDTC,"HOURS CNT"))+1
. S ^("HOURS")=$G(^TMP("ACDRR2",ACDJOB,ACDBT,"VISIT TYPE",ACDTC,ACDCS,"HOURS"))+ACDHRS
. S ^("HOURS CNT")=$G(^TMP("ACDRR2",ACDJOB,ACDBT,"VISIT TYPE",ACDTC,ACDCS,"HOURS CNT"))+1
. S ACDWPIEN=0
. ;F S ACDWPIEN=$O(^ACDCS(ACDCSIEN,1,ACDWPIEN)) Q:'ACDWPIEN S X=+^(ACDWPIEN,0) D PFTV^XBPFTV(6,X,.ACDWPROV) D ; ** ^DIC(6, **
. F S ACDWPIEN=$O(^ACDCS(ACDCSIEN,1,ACDWPIEN)) Q:'ACDWPIEN S X=+^(ACDWPIEN,0),ACDWPROV=$P($G(^VA(200,X,0)),U) S:ACDWPROV="" ACDWPROV=X D
.. S ^("COUNT")=$G(^TMP("ACDRR2",ACDJOB,ACDBT,"PROV",ACDWPROV,"VT",ACDTC,"COUNT"))+1
.. S ^("HOURS")=$G(^TMP("ACDRR2",ACDJOB,ACDBT,"PROV",ACDWPROV,"VT",ACDTC,"HOURS"))+ACDHRS
.. S ^("HOURS CNT")=$G(^TMP("ACDRR2",ACDJOB,ACDBT,"PROV",ACDWPROV,"VT",ACDTC,"HOURS CNT"))+1
.. S ^("HOURS")=$G(^TMP("ACDRR2",ACDJOB,ACDBT,"PROV",ACDWPROV,"VT",ACDTC,ACDCS,"HOURS"))+ACDHRS
.. S ^("HOURS CNT")=$G(^TMP("ACDRR2",ACDJOB,ACDBT,"PROV",ACDWPROV,"VT",ACDTC,ACDCS,"HOURS CNT"))+1
.. Q
. Q
Q
;
COMPUTE1 ; COMPUTE TOTALS TO PASS TO PRINT ROUTINE
S (C,ACDPIEN)=0
; compute number of patients seen
F S ACDPIEN=$O(^TMP("ACDRR2",ACDJOB,ACDBT,"PATIENT",ACDPIEN)) Q:'ACDPIEN S C=C+1
S ^TMP("ACDRR2",ACDJOB,ACDBT,"SEEN")=C
K ^TMP("ACDRR2",ACDJOB,ACDBT,"PATIENT")
; compute number of patients each provider is the pri-prov for
S ACDPROV=""
F S ACDPROV=$O(^TMP("ACDRR2",ACDJOB,ACDBT,"PP",ACDPROV)) Q:ACDPROV="" D
. S (C,ACDPIEN)=0
. F S ACDPIEN=$O(^TMP("ACDRR2",ACDJOB,ACDBT,"PP",ACDPROV,ACDPIEN)) Q:'ACDPIEN S C=C+1
. S ^TMP("ACDRR2",ACDJOB,ACDBT,"PROV",ACDPROV,"PP")=C
. Q
K ^TMP("ACDRR2",ACDJOB,ACDBT,"PP")
; compute totals by provider
S ACDPROV=""
F S ACDPROV=$O(^TMP("ACDRR2",ACDJOB,ACDBT,"PROV",ACDPROV)) Q:ACDPROV="" D
. S ACDTC=""
. F S ACDTC=$O(^TMP("ACDRR2",ACDJOB,ACDBT,"PROV",ACDPROV,"VT",ACDTC)) Q:ACDTC="" D
.. I ACDTC="CS" D CS Q ; compute CS and quit
.. S Y=+$G(^TMP("ACDRR2",ACDJOB,ACDBT,"PROV",ACDPROV,"VT",ACDTC,"HOURS"))
.. S ^("TOTAL HOURS")=+$G(^TMP("ACDRR2",ACDJOB,ACDBT,"PROV",ACDPROV,"TOT","TOTAL HOURS"))+Y
.. D CLASS
.. S:ACDCLASS=1 ^("IN/RE/TD/FU HOURS")=+$G(^TMP("ACDRR2",ACDJOB,ACDBT,"PROV",ACDPROV,"TOT","IN/RE/TD/FU HOURS"))+Y
.. S:ACDCLASS=2 ^("IR HOURS")=+$G(^TMP("ACDRR2",ACDJOB,ACDBT,"PROV",ACDPROV,"TOT","IR HOURS"))+Y
.. S:ACDCLASS=3 ^("OT HOURS")=+$G(^TMP("ACDRR2",ACDJOB,ACDBT,"PROV",ACDPROV,"TOT","OT HOURS"))+Y
.. S Y=+$G(^TMP("ACDRR2",ACDJOB,ACDBT,"PROV",ACDPROV,"VT",ACDTC,"HOURS NR"))
.. S ^("HOURS NR")=+$G(^TMP("ACDRR2",ACDJOB,ACDBT,"PROV",ACDPROV,"TOT","HOURS NR"))+Y
.. Q
. Q
Q
;
CLASS ; COMPUTE CLASS OF VISIT
S ACDCLASS=1
I ACDTC="IR" S ACDCLASS=2 Q
I ACDTC="OT" S ACDCLASS=3 Q
Q
;
CS ; COMPUTE CS TOTALS
S ACDCS=0
F S ACDCS=$O(^TMP("ACDRR2",ACDJOB,ACDBT,"PROV",ACDPROV,"VT",ACDTC,ACDCS)) Q:'ACDCS S Y=+$G(^(ACDCS,"HOURS")) D
. S ^("TOTAL HOURS")=+$G(^TMP("ACDRR2",ACDJOB,ACDBT,"PROV",ACDPROV,"TOT","TOTAL HOURS"))+Y
. S ^("CS HOURS")=+$G(^TMP("ACDRR2",ACDJOB,ACDBT,"PROV",ACDPROV,"CS HOURS"))+Y
. Q
Q
;
;
PREVENT ; PROCESS ALL PREVENTIONS WITHIN DATE RANGE
S ACDPDATE=$O(^ACDPD("B",ACDDTLO),-1)
F S ACDPDATE=$O(^ACDPD("B",ACDPDATE)) Q:ACDPDATE=""!(ACDPDATE>ACDDTHI) D
. S ACDPIEN=0
. F S ACDPIEN=$O(^ACDPD("B",ACDPDATE,ACDPIEN)) Q:'ACDPIEN D
.. Q:'$D(^ACDPD(ACDPIEN,0)) ; bad xref
.. S X=^ACDPD(ACDPIEN,0)
.. S X=$P(X,U,5) ; primary provider
.. ;D PFTV^XBPFTV(6,X,.ACDPPROV) ; ** ^DIC(6, **
.. S ACDPPROV=$P($G(^VA(200,X,0)),U)
.. S:ACDPPROV="" ACDPPROV=X
.. S ACDPDAY=0
.. F S ACDPDAY=$O(^ACDPD(ACDPIEN,1,ACDPDAY)) Q:'ACDPDAY D PRVDAY
.. Q
. Q
Q
;
PRVDAY ; PROCESS ONE PREVENTION DAY
S X=^ACDPD(ACDPIEN,1,ACDPDAY,0)
S ^("COUNT")=$G(^TMP("ACDRR2",ACDJOB,ACDBT,"VISIT TYPE","PREV","COUNT"))+1
S ACDPACT=$P(X,U,2)
S ACDHRS=$P(X,U,8)
I 'ACDHRS S ^("HOURS NR")=$G(^TMP("ACDRR2",ACDJOB,ACDBT,"VISIT TYPE","PREV","HOURS NR"))+1 Q
S ^("HOURS")=$G(^TMP("ACDRR2",ACDJOB,ACDBT,"VISIT TYPE","PREV","HOURS"))+ACDHRS
S ^("HOURS CNT")=$G(^TMP("ACDRR2",ACDJOB,ACDBT,"VISIT TYPE","PREV","HOURS CNT"))+1
S ^("HOURS")=$G(^TMP("ACDRR2",ACDJOB,ACDBT,"VISIT TYPE","PREV",ACDPACT,"HOURS"))+ACDHRS
S ^("HOURS CNT")=$G(^TMP("ACDRR2",ACDJOB,ACDBT,"VISIT TYPE","PREV",ACDPACT,"HOURS CNT"))+1
S ACDPRVM=0
F S ACDPRVM=$O(^ACDPD(ACDPIEN,1,ACDPDAY,"PRV",ACDPRVM)) Q:'ACDPRVM D
. S ACDWPROV=+^ACDPD(ACDPIEN,1,ACDPDAY,"PRV",ACDPRVM,0)
. ;D PFTV^XBPFTV(6,ACDWPROV,.ACDWPROV) ; ** ^DIC(6, **
. S ACDX=$P($G(^VA(200,ACDWPROV,0)),U)
. S:ACDX'="" ACDWPROV=ACDX
. S ^("COUNT")=$G(^TMP("ACDRR2",ACDJOB,ACDBT,"PROV",ACDWPROV,"VT","PREV","COUNT"))+1
. S ^("HOURS CNT")=$G(^TMP("ACDRR2",ACDJOB,ACDBT,"PROV",ACDWPROV,"VT","PREV","HOURS CNT"))+1
. S ^("HOURS")=$G(^TMP("ACDRR2",ACDJOB,ACDBT,"PROV",ACDWPROV,"VT","PREV","HOURS"))+ACDHRS
. S ^("COUNT")=$G(^TMP("ACDRR2",ACDJOB,ACDBT,"PROV",ACDWPROV,"VT","PREV",ACDPACT,"COUNT"))+1
. S ^("HOURS")=$G(^TMP("ACDRR2",ACDJOB,ACDBT,"PROV",ACDWPROV,"VT","PREV",ACDPACT,"HOURS"))+ACDHRS
. S ^("HOURS CNT")=$G(^TMP("ACDRR2",ACDJOB,ACDBT,"PROV",ACDWPROV,"VT","PREV",ACDPACT,"HOURS CNT"))+1
. Q
Q
;
INTERV ; PROCESS ALL INTERVENTIONS WITHIN DATE RANGE
D INTERV^ACDRR2CB
Q
;
EOJ ;
S ACDET=$H
K C,X,Y,Z
Q
ACDRR2C ; IHS/ADC/EDE/KML - GATHER WORKLOAD DATA ;
+1 ;;4.1;CHEMICAL DEPENDENCY MIS;;MAY 11, 1998
+2 ;
+3 ; This routine processes each visit within date range, gathers
+4 ; provider workload data, then processes other file entries
+5 ; by the same date range.
+6 ;
START ;
+1 DO INIT
+2 DO VISITS
+3 DO COMPUTE1
+4 DO PREVENT
+5 DO INTERV
+6 DO EOJ
+7 QUIT
+8 ;
INIT ;
+1 SET (ACDBT,ACDBTH)=$HOROLOG
SET ACDJOB=$JOB
+2 KILL ^TMP("ACDRR2",$JOB)
+3 QUIT
+4 ;
VISITS ; PROCESS ALL VISITS WITHIN DATE RANGE
+1 SET ACDVDATE=$ORDER(^ACDVIS("B",ACDDTLO),-1)
+2 FOR
SET ACDVDATE=$ORDER(^ACDVIS("B",ACDVDATE))
IF ACDVDATE=""!(ACDVDATE>ACDDTHI)
QUIT
Begin DoDot:1
+3 SET ACDVIEN=0
+4 FOR
SET ACDVIEN=$ORDER(^ACDVIS("B",ACDVDATE,ACDVIEN))
IF 'ACDVIEN
QUIT
DO VISIT
+5 QUIT
End DoDot:1
+6 QUIT
+7 ;
VISIT ; PROCESS ONE VISIT
+1 ; bad xref
IF '$DATA(^ACDVIS(ACDVIEN,0))
QUIT
+2 ;not from current program
IF $GET(^ACDVIS(ACDVIEN,"BWP"))'=ACDPGM
QUIT
+3 SET X=^ACDVIS(ACDVIEN,0)
+4 ; type contact
SET ACDTC=$PIECE(X,U,4)
+5 ; primary provider
SET Y=$PIECE(X,U,3)
+6 ;D PFTV^XBPFTV(6,Y,.ACDPPROV) ; ** ^DIC(6, **
+7 SET ACDPPROV=$PIECE($GET(^VA(200,Y,0)),U)
+8 IF ACDPPROV=""
SET ACDPPROV=Y
+9 ; patient ien
SET ACDPIEN=$PIECE(X,U,5)
+10 IF ACDPIEN
Begin DoDot:1
+11 SET ^TMP("ACDRR2",ACDJOB,ACDBT,"PATIENT",ACDPIEN)=""
+12 SET ^TMP("ACDRR2",ACDJOB,ACDBT,"PP",ACDPPROV,ACDPIEN)=""
+13 QUIT
End DoDot:1
+14 ; process iif/td
DO @("PRC"_ACDTC)
+15 QUIT
+16 ;
PRCIN ; INITIAL
+1 DO PRCIIF
+2 QUIT
+3 ;
PRCRE ; REOPEN
+1 DO PRCIIF
+2 QUIT
+3 ;
PRCFU ; FOLLOWUP
+1 DO PRCIIF
+2 QUIT
+3 ;
PRCIR ; INFO/REFERRAL
+1 DO PRCIIF
+2 QUIT
+3 ;
PRCOT ; CRISIS BRIEF
+1 DO PRCIIF
+2 QUIT
+3 ;
PRCIIF ; PROCESS IIF ENTRY
+1 SET ACDIIEN=$ORDER(^ACDIIF("C",ACDVIEN,0))
+2 ; no iif entry
IF 'ACDIIEN
QUIT
+3 ; bad xref
IF '$DATA(^ACDIIF(ACDIIEN,0))
QUIT
+4 SET ^("COUNT")=$GET(^TMP("ACDRR2",ACDJOB,ACDBT,"PROV",ACDPPROV,"VT",ACDTC,"COUNT"))+1
+5 SET ^("COUNT")=$GET(^TMP("ACDRR2",ACDJOB,ACDBT,"VISIT TYPE",ACDTC,"COUNT"))+1
+6 SET X=^ACDIIF(ACDIIEN,0)
+7 SET ACDHRS=$PIECE(X,U,6)
+8 IF 'ACDHRS
SET ^("HOURS NR")=$GET(^TMP("ACDRR2",ACDJOB,ACDBT,"PROV",ACDPPROV,"VT",ACDTC,"HOURS NR"))+1
SET ^("HOURS NR")=$GET(^TMP("ACDRR2",ACDJOB,ACDBT,"VISIT TYPE",ACDTC,"HOURS NR"))+1
QUIT
+9 SET ^("HOURS")=$GET(^TMP("ACDRR2",ACDJOB,ACDBT,"PROV",ACDPPROV,"VT",ACDTC,"HOURS"))+ACDHRS
SET ^("HOURS")=$GET(^TMP("ACDRR2",ACDJOB,ACDBT,"VISIT TYPE",ACDTC,"HOURS"))+ACDHRS
+10 SET ^("HOURS CNT")=$GET(^TMP("ACDRR2",ACDJOB,ACDBT,"PROV",ACDPPROV,"VT",ACDTC,"HOURS CNT"))+1
SET ^("HOURS CNT")=$GET(^TMP("ACDRR2",ACDJOB,ACDBT,"VISIT TYPE",ACDTC,"HOURS CNT"))+1
+11 QUIT
+12 ;
PRCTD ; TRANS/DISC/CLOSE ENTRY
+1 SET ACDTIEN=$ORDER(^ACDTDC("C",ACDVIEN,0))
+2 ; no tdc entry
IF 'ACDTIEN
QUIT
+3 ; bad xref
IF '$DATA(^ACDTDC(ACDTIEN,0))
QUIT
+4 SET ^("COUNT")=$GET(^TMP("ACDRR2",ACDJOB,ACDBT,"PROV",ACDPPROV,"VT",ACDTC,"COUNT"))+1
+5 SET X=^ACDTDC(ACDTIEN,0)
+6 SET ACDHRS=$PIECE(X,U,29)
+7 IF 'ACDHRS
SET ^("HOURS NR")=$GET(^TMP("ACDRR2",ACDJOB,ACDBT,"PROV",ACDPPROV,"VT",ACDTC,"HOURS NR"))+1
SET ^("HOURS NR")=$GET(^TMP("ACDRR2",ACDJOB,ACDBT,"VISIT TYPE",ACDTC,"HOURS NR"))+1
QUIT
+8 SET ^("HOURS")=$GET(^TMP("ACDRR2",ACDJOB,ACDBT,"PROV",ACDPPROV,"VT",ACDTC,"HOURS"))+ACDHRS
SET ^("HOURS")=$GET(^TMP("ACDRR2",ACDJOB,ACDBT,"VISIT TYPE",ACDTC,"HOURS"))+ACDHRS
+9 SET ^("HOURS CNT")=$GET(^TMP("ACDRR2",ACDJOB,ACDBT,"PROV",ACDPPROV,"VT",ACDTC,"HOURS CNT"))+1
SET ^("HOURS CNT")=$GET(^TMP("ACDRR2",ACDJOB,ACDBT,"VISIT TYPE",ACDTC,"HOURS CNT"))+1
+10 QUIT
+11 ;
PRCCS ; CLIENT SERVICES
+1 SET ACDCSIEN=0
+2 FOR
SET ACDCSIEN=$ORDER(^ACDCS("C",ACDVIEN,ACDCSIEN))
IF 'ACDCSIEN
QUIT
IF $DATA(^ACDCS(ACDCSIEN,0))
SET X=^(0)
Begin DoDot:1
+3 SET ^("COUNT")=$GET(^TMP("ACDRR2",ACDJOB,ACDBT,"VISIT TYPE",ACDTC,"COUNT"))+1
+4 SET ACDCS=$PIECE(X,U,2)
+5 SET ACDHRS=$PIECE(X,U,4)
+6 IF 'ACDHRS
SET ^("HOURS NR")=$GET(^TMP("ACDRR2",ACDJOB,ACDBT,"VISIT TYPE",ACDTC,"HOURS NR"))+1
QUIT
+7 SET ^("HOURS")=$GET(^TMP("ACDRR2",ACDJOB,ACDBT,"VISIT TYPE",ACDTC,"HOURS"))+ACDHRS
+8 SET ^("HOURS CNT")=$GET(^TMP("ACDRR2",ACDJOB,ACDBT,"VISIT TYPE",ACDTC,"HOURS CNT"))+1
+9 SET ^("HOURS")=$GET(^TMP("ACDRR2",ACDJOB,ACDBT,"VISIT TYPE",ACDTC,ACDCS,"HOURS"))+ACDHRS
+10 SET ^("HOURS CNT")=$GET(^TMP("ACDRR2",ACDJOB,ACDBT,"VISIT TYPE",ACDTC,ACDCS,"HOURS CNT"))+1
+11 SET ACDWPIEN=0
+12 ;F S ACDWPIEN=$O(^ACDCS(ACDCSIEN,1,ACDWPIEN)) Q:'ACDWPIEN S X=+^(ACDWPIEN,0) D PFTV^XBPFTV(6,X,.ACDWPROV) D ; ** ^DIC(6, **
+13 FOR
SET ACDWPIEN=$ORDER(^ACDCS(ACDCSIEN,1,ACDWPIEN))
IF 'ACDWPIEN
QUIT
SET X=+^(ACDWPIEN,0)
SET ACDWPROV=$PIECE($GET(^VA(200,X,0)),U)
IF ACDWPROV=""
SET ACDWPROV=X
Begin DoDot:2
+14 SET ^("COUNT")=$GET(^TMP("ACDRR2",ACDJOB,ACDBT,"PROV",ACDWPROV,"VT",ACDTC,"COUNT"))+1
+15 SET ^("HOURS")=$GET(^TMP("ACDRR2",ACDJOB,ACDBT,"PROV",ACDWPROV,"VT",ACDTC,"HOURS"))+ACDHRS
+16 SET ^("HOURS CNT")=$GET(^TMP("ACDRR2",ACDJOB,ACDBT,"PROV",ACDWPROV,"VT",ACDTC,"HOURS CNT"))+1
+17 SET ^("HOURS")=$GET(^TMP("ACDRR2",ACDJOB,ACDBT,"PROV",ACDWPROV,"VT",ACDTC,ACDCS,"HOURS"))+ACDHRS
+18 SET ^("HOURS CNT")=$GET(^TMP("ACDRR2",ACDJOB,ACDBT,"PROV",ACDWPROV,"VT",ACDTC,ACDCS,"HOURS CNT"))+1
+19 QUIT
End DoDot:2
+20 QUIT
End DoDot:1
+21 QUIT
+22 ;
COMPUTE1 ; COMPUTE TOTALS TO PASS TO PRINT ROUTINE
+1 SET (C,ACDPIEN)=0
+2 ; compute number of patients seen
+3 FOR
SET ACDPIEN=$ORDER(^TMP("ACDRR2",ACDJOB,ACDBT,"PATIENT",ACDPIEN))
IF 'ACDPIEN
QUIT
SET C=C+1
+4 SET ^TMP("ACDRR2",ACDJOB,ACDBT,"SEEN")=C
+5 KILL ^TMP("ACDRR2",ACDJOB,ACDBT,"PATIENT")
+6 ; compute number of patients each provider is the pri-prov for
+7 SET ACDPROV=""
+8 FOR
SET ACDPROV=$ORDER(^TMP("ACDRR2",ACDJOB,ACDBT,"PP",ACDPROV))
IF ACDPROV=""
QUIT
Begin DoDot:1
+9 SET (C,ACDPIEN)=0
+10 FOR
SET ACDPIEN=$ORDER(^TMP("ACDRR2",ACDJOB,ACDBT,"PP",ACDPROV,ACDPIEN))
IF 'ACDPIEN
QUIT
SET C=C+1
+11 SET ^TMP("ACDRR2",ACDJOB,ACDBT,"PROV",ACDPROV,"PP")=C
+12 QUIT
End DoDot:1
+13 KILL ^TMP("ACDRR2",ACDJOB,ACDBT,"PP")
+14 ; compute totals by provider
+15 SET ACDPROV=""
+16 FOR
SET ACDPROV=$ORDER(^TMP("ACDRR2",ACDJOB,ACDBT,"PROV",ACDPROV))
IF ACDPROV=""
QUIT
Begin DoDot:1
+17 SET ACDTC=""
+18 FOR
SET ACDTC=$ORDER(^TMP("ACDRR2",ACDJOB,ACDBT,"PROV",ACDPROV,"VT",ACDTC))
IF ACDTC=""
QUIT
Begin DoDot:2
+19 ; compute CS and quit
IF ACDTC="CS"
DO CS
QUIT
+20 SET Y=+$GET(^TMP("ACDRR2",ACDJOB,ACDBT,"PROV",ACDPROV,"VT",ACDTC,"HOURS"))
+21 SET ^("TOTAL HOURS")=+$GET(^TMP("ACDRR2",ACDJOB,ACDBT,"PROV",ACDPROV,"TOT","TOTAL HOURS"))+Y
+22 DO CLASS
+23 IF ACDCLASS=1
SET ^("IN/RE/TD/FU HOURS")=+$GET(^TMP("ACDRR2",ACDJOB,ACDBT,"PROV",ACDPROV,"TOT","IN/RE/TD/FU HOURS"))+Y
+24 IF ACDCLASS=2
SET ^("IR HOURS")=+$GET(^TMP("ACDRR2",ACDJOB,ACDBT,"PROV",ACDPROV,"TOT","IR HOURS"))+Y
+25 IF ACDCLASS=3
SET ^("OT HOURS")=+$GET(^TMP("ACDRR2",ACDJOB,ACDBT,"PROV",ACDPROV,"TOT","OT HOURS"))+Y
+26 SET Y=+$GET(^TMP("ACDRR2",ACDJOB,ACDBT,"PROV",ACDPROV,"VT",ACDTC,"HOURS NR"))
+27 SET ^("HOURS NR")=+$GET(^TMP("ACDRR2",ACDJOB,ACDBT,"PROV",ACDPROV,"TOT","HOURS NR"))+Y
+28 QUIT
End DoDot:2
+29 QUIT
End DoDot:1
+30 QUIT
+31 ;
CLASS ; COMPUTE CLASS OF VISIT
+1 SET ACDCLASS=1
+2 IF ACDTC="IR"
SET ACDCLASS=2
QUIT
+3 IF ACDTC="OT"
SET ACDCLASS=3
QUIT
+4 QUIT
+5 ;
CS ; COMPUTE CS TOTALS
+1 SET ACDCS=0
+2 FOR
SET ACDCS=$ORDER(^TMP("ACDRR2",ACDJOB,ACDBT,"PROV",ACDPROV,"VT",ACDTC,ACDCS))
IF 'ACDCS
QUIT
SET Y=+$GET(^(ACDCS,"HOURS"))
Begin DoDot:1
+3 SET ^("TOTAL HOURS")=+$GET(^TMP("ACDRR2",ACDJOB,ACDBT,"PROV",ACDPROV,"TOT","TOTAL HOURS"))+Y
+4 SET ^("CS HOURS")=+$GET(^TMP("ACDRR2",ACDJOB,ACDBT,"PROV",ACDPROV,"CS HOURS"))+Y
+5 QUIT
End DoDot:1
+6 QUIT
+7 ;
+8 ;
PREVENT ; PROCESS ALL PREVENTIONS WITHIN DATE RANGE
+1 SET ACDPDATE=$ORDER(^ACDPD("B",ACDDTLO),-1)
+2 FOR
SET ACDPDATE=$ORDER(^ACDPD("B",ACDPDATE))
IF ACDPDATE=""!(ACDPDATE>ACDDTHI)
QUIT
Begin DoDot:1
+3 SET ACDPIEN=0
+4 FOR
SET ACDPIEN=$ORDER(^ACDPD("B",ACDPDATE,ACDPIEN))
IF 'ACDPIEN
QUIT
Begin DoDot:2
+5 ; bad xref
IF '$DATA(^ACDPD(ACDPIEN,0))
QUIT
+6 SET X=^ACDPD(ACDPIEN,0)
+7 ; primary provider
SET X=$PIECE(X,U,5)
+8 ;D PFTV^XBPFTV(6,X,.ACDPPROV) ; ** ^DIC(6, **
+9 SET ACDPPROV=$PIECE($GET(^VA(200,X,0)),U)
+10 IF ACDPPROV=""
SET ACDPPROV=X
+11 SET ACDPDAY=0
+12 FOR
SET ACDPDAY=$ORDER(^ACDPD(ACDPIEN,1,ACDPDAY))
IF 'ACDPDAY
QUIT
DO PRVDAY
+13 QUIT
End DoDot:2
+14 QUIT
End DoDot:1
+15 QUIT
+16 ;
PRVDAY ; PROCESS ONE PREVENTION DAY
+1 SET X=^ACDPD(ACDPIEN,1,ACDPDAY,0)
+2 SET ^("COUNT")=$GET(^TMP("ACDRR2",ACDJOB,ACDBT,"VISIT TYPE","PREV","COUNT"))+1
+3 SET ACDPACT=$PIECE(X,U,2)
+4 SET ACDHRS=$PIECE(X,U,8)
+5 IF 'ACDHRS
SET ^("HOURS NR")=$GET(^TMP("ACDRR2",ACDJOB,ACDBT,"VISIT TYPE","PREV","HOURS NR"))+1
QUIT
+6 SET ^("HOURS")=$GET(^TMP("ACDRR2",ACDJOB,ACDBT,"VISIT TYPE","PREV","HOURS"))+ACDHRS
+7 SET ^("HOURS CNT")=$GET(^TMP("ACDRR2",ACDJOB,ACDBT,"VISIT TYPE","PREV","HOURS CNT"))+1
+8 SET ^("HOURS")=$GET(^TMP("ACDRR2",ACDJOB,ACDBT,"VISIT TYPE","PREV",ACDPACT,"HOURS"))+ACDHRS
+9 SET ^("HOURS CNT")=$GET(^TMP("ACDRR2",ACDJOB,ACDBT,"VISIT TYPE","PREV",ACDPACT,"HOURS CNT"))+1
+10 SET ACDPRVM=0
+11 FOR
SET ACDPRVM=$ORDER(^ACDPD(ACDPIEN,1,ACDPDAY,"PRV",ACDPRVM))
IF 'ACDPRVM
QUIT
Begin DoDot:1
+12 SET ACDWPROV=+^ACDPD(ACDPIEN,1,ACDPDAY,"PRV",ACDPRVM,0)
+13 ;D PFTV^XBPFTV(6,ACDWPROV,.ACDWPROV) ; ** ^DIC(6, **
+14 SET ACDX=$PIECE($GET(^VA(200,ACDWPROV,0)),U)
+15 IF ACDX'=""
SET ACDWPROV=ACDX
+16 SET ^("COUNT")=$GET(^TMP("ACDRR2",ACDJOB,ACDBT,"PROV",ACDWPROV,"VT","PREV","COUNT"))+1
+17 SET ^("HOURS CNT")=$GET(^TMP("ACDRR2",ACDJOB,ACDBT,"PROV",ACDWPROV,"VT","PREV","HOURS CNT"))+1
+18 SET ^("HOURS")=$GET(^TMP("ACDRR2",ACDJOB,ACDBT,"PROV",ACDWPROV,"VT","PREV","HOURS"))+ACDHRS
+19 SET ^("COUNT")=$GET(^TMP("ACDRR2",ACDJOB,ACDBT,"PROV",ACDWPROV,"VT","PREV",ACDPACT,"COUNT"))+1
+20 SET ^("HOURS")=$GET(^TMP("ACDRR2",ACDJOB,ACDBT,"PROV",ACDWPROV,"VT","PREV",ACDPACT,"HOURS"))+ACDHRS
+21 SET ^("HOURS CNT")=$GET(^TMP("ACDRR2",ACDJOB,ACDBT,"PROV",ACDWPROV,"VT","PREV",ACDPACT,"HOURS CNT"))+1
+22 QUIT
End DoDot:1
+23 QUIT
+24 ;
INTERV ; PROCESS ALL INTERVENTIONS WITHIN DATE RANGE
+1 DO INTERV^ACDRR2CB
+2 QUIT
+3 ;
EOJ ;
+1 SET ACDET=$HOROLOG
+2 KILL C,X,Y,Z
+3 QUIT
