ACDWSTAF ;IHS/ADC/EDE/KML - STAFF REPORTS 10:19;
;;4.1;CHEMICAL DEPENDENCY MIS;;MAY 11, 1998
;//[ACD R6-SAR]
EN ;
K DIRUT
;
;Initialize counter forTOT CLIENT SERVICE HOURS (ACDTH)
; TOT PREVENTION HOURS (ACDTHP)
; TOT CRISIS BRIEF HOURS (ACDTHOT)
; TOT CLIENT SERVICE VISITS (ACDCNUMT)
; TOT UNIQ CLIENTS SEEN (ACDCLIU)
S ACDTH=0,ACDTHP=0,ACDTHOT=0,ACDCNUMT=0 K ACDCLIU
;
;Initialize counter for total visits found on report
S ACDVNUM=0
;
;Set flag variable for tasking
S ACDWSTAF(1)=1
;
;Ask for only one provider
K ACDGVER
;K DIC S DIC="^DIC(6,",DIC(0)="AEQ" D ^DIC Q:Y<0 S ACDGVER=+Y
K DIC S DIC="^VA(200,",DIC(0)="AEQ",DIC("S")="I $D(^XUSEC(""PROVIDER"",+Y))" D ^DIC Q:Y<0 S ACDGVER=+Y
I '$D(ACDGVER) S ACDQUIT=1 Q
;
;Ask for whole report or a summary only.
S DIR(0)="S^1:PRINT FULL REPORT;2:PRINT SUMMARY REPORT" D ^DIR G:X["^"!($D(DTOUT)!(X="")) K
K ACDSUMRP I Y=2 S ACDSUMRP=2
;
;Ask for date range to gather data
D D^ACDWRQ G:$D(ACDQUIT) K
D HV^ACDWUTL
;
;Queue
D ^ACDWQ ; call to XBDBQUE
Q
;
L ;EP - FOR TASKMAN (XBDBQUE)
Q
;
P ;EP - PRINT REPORT
; Order on visit i.e. ^ACDVIS
K DIRUT
U IO D H
S ACDFR=$E(ACDFR,1,5)_"00"
F ACD=ACDFR-.01:0 S ACD=$O(^ACDVIS("B",ACD)) Q:'ACD!(ACD>ACDTO) F ACDV=0:0 S ACDV=$O(^ACDVIS("B",ACD,ACDV)) Q:'ACDV S ACDDA=ACDV D ^ACDWVIS I ACD6DIG=ACDAUF D V1 Q:$D(DIRUT)
;
;Get prevention data
D ^ACDWSTA1
Q:$D(DIRUT)
;
I $D(ACDSUMRP) W !,"S U M M A R Y O N L Y",!!
W !,"NOTE: THIS REPORT DOES 'NOT INCLUDE' ANY INTERVENTION DATA.",!!
D EN^ACDV4MES
W !!,"SEARCH CRITERIA IS THAT: THE PROVIDER NAME WAS ENTERED",!,"DURING DATA ENTRY INTO THE FIELD TITLED 'PROVIDER TO CREDIT WORKLOAD' FOR "
W !,"CONTACT TYPES OF CLIENT SERVICE AND PREVENTIONS."
W !!,"SEARCH CRITERIA IS THAT: FOR ALL OTHER CONTACT TYPES",!,"WHERE THERE IS NO FIELD CALLED 'PROVIDER TO CREDIT WORKLOAD', THE 'PROVIDER'",!,"FIELD IS USED TO FIND A MATCH.",!!
W !,"H O U R S W O R K - L O A D D A T A"
D F W !,"TOT HOURS FOR CLIENT SERVICE CONTACTS: ",?70,ACDTH
D F W !,"TOT HOURS FOR PREVENTION CONTACTS: ",?70,ACDTHP
D F W !,"TOT HOURS FOR CRISIS/BRIEF CONTACTS: ",?70,ACDTHOT
W !!,"V I S I T W O R K - L O A D D A T A"
D F W !,"TOT CLIENT VISITS: ",?70,ACDVNUM
W !,"(INCLUDES PREVENTION VISITS)",!
D F W !,"TOT CLIENT SERVICES:",?70,ACDCNUMT
W !,"(REMEMBER: MANY CLIENTS SERVICES MAY BELONG TO THE SAME VISIT)",!!
D F W !,"TOT UNIQ CLIENTS SEEN:",?70 S ACDCLIU=0 F ACD=0:0 S ACD=$O(ACDCLIU(ACD)) Q:'ACD S ACDCLIU=ACDCLIU+1
W ACDCLIU
D F^ACDWUTL
W @IOF
Q
;
V1 ;
;
;If Contact is 'OT' get hours for grand total
I ACDCONTL="CRISIS/BRIEF INT",ACDPROVP=ACDGVER S ACDOTHRS=$O(^ACDIIF("C",ACDV,0)) D
. I ACDOTHRS]"" S ACDOTHRS=$P(^ACDIIF(ACDOTHRS,0),U,6),ACDTHOT=ACDTHOT+ACDOTHRS
;
;If contact is not a client service visit, then the provider for the
;visit must match the selected provider. All contacts except prevention
;and client service will have only one provider. Secondary providers
;may exist on preventions and client services.
I ACDCONTL'="CLIENT SERVICE",ACDPROVP'=ACDGVER Q
;
;
;Increment visit counter,unique client counter
S ACDVNUM=ACDVNUM+1 S ACDCLIU(ACDDFNP)=""
;
;Not a client service/prevention so simply output visit information
;then quit
I ACDCONTL'="CLIENT SERVICE",ACDPROVP=ACDGVER D F Q:$D(DIRUT) I '$D(ACDSUMRP) W !,ACDVNUM,")",?5,ACDCLIV,?18,$E(ACDPG,1,12),?31,ACDCONTL W:ACDCONTL="CRISIS/BRIEF INT" "/",ACDOTHRS W ?60,$E(ACDDFN,1,19) Q
Q:$D(DIRUT)
;
;
;Initialize counter for number of client services the provider was
;involved in within the single visit. (ACDCNUM)
;
;Initialize the counter for grand total hours within the visit.
S (ACDOK,ACDCNUM,ACDVH)=0
;
D CK
Q:'ACDOK
D F Q:$D(DIRUT) I '$D(ACDSUMRP) W !!,ACDVNUM,")",?5,ACDCLIV,?18,$E(ACDPG,1,12),?31,ACDCONTL,?60,$E(ACDDFN,1,19),!!?14,"Primary Provider: ",?40,$S($D(^VA(200,ACDPROVP,0)):$P(^VA(200,ACDPROVP,0),U),1:"UNKNOWN")
Q:$D(DIRUT)
;
;F ACD1=0:0 S ACD1=$O(^ACDCS("C",ACDV,ACD1)) Q:'ACD1 I $D(^ACDCS(ACD1,1,ACDGVER,0)) S ACDDA=ACD1 D ^ACDWCS Q:$D(DIRUT) D V2 Q:$D(DIRUT)
; replace above line (BUG fix). Needed to retrieve the ptr multiple
; for the provider(s) to credit workload (bug fix) since the ptr is
; not always equal to the provider ien which the replaced logic assumes
F ACD1=0:0 S ACD1=$O(^ACDCS("C",ACDV,ACD1)) Q:'ACD1 I $D(^ACDCS(ACD1,1,0)) D
. S PRVCR=$P(^ACDCS(ACD1,1,0),U,3)
. I $G(^ACDCS(ACD1,1,PRVCR,0))=ACDGVER S ACDDA=ACD1 D ^ACDWCS Q:$D(DIRUT) D V2 Q:$D(DIRUT)
K PRVCR
Q:$D(DIRUT)
D F Q:$D(DIRUT) I '$D(ACDSUMRP) W !?14,"TOT HOURS FOR VISIT: ",?40,ACDVH,!
Q
V2 ;
S ACDCNUM=ACDCNUM+1,ACDCNUMT=ACDCNUMT+1
D F I '$D(ACDSUMRP) W !?8,ACDCNUM,")",?14,"Provider(s) credited: ",?40,$S($D(^VA(200,ACDGVER,0)):$P(^VA(200,ACDGVER,0),U),1:"UNKNOWN")
D F I '$D(ACDSUMRP) W !?14,"DAY",?40,ACDDAY
D F I '$D(ACDSUMRP) W !?14,"SERVICE",?40,ACDSVAC
D F I '$D(ACDSUMRP) W !?14,"LOCATION",?40,ACDLOTY
D F I '$D(ACDSUMRP) W !?14,"HOUR",?40,ACDHOUR
S ACDTH=ACDTH+ACDHOUR,ACDVH=ACDVH+ACDHOUR
Q
CK ;
;See if provider was involved with any of the client services. If so,
;set ok to 1 and now I can print out the visit data with the
;primary provider knowing the primary provider may not be the selected
;provider
S ACDOK=0
I ACDPROVP=ACDGVER S ACDOK=1 Q
;F ACD1=0:0 S ACD1=$O(^ACDCS("C",ACDV,ACD1)) Q:'ACD1 S ACDDA=ACD1 D ^ACDWCS I $D(^ACDCS(ACD1,1,ACDGVER,0)) S ACDOK=1
; replace above line (BUG fix). Needed to retrieve the ptr multiple
; for the provider(s) to credit workload (bug fix) since the ptr is
; not always equal to the provider ien which the replaced logic assumes
F ACD1=0:0 S ACD1=$O(^ACDCS("C",ACDV,ACD1)) Q:'ACD1 S ACDDA=ACD1 D ^ACDWCS I $D(^ACDCS(ACD1,1,0)) D
. S PRVCR=$P(^ACDCS(ACD1,1,0),U,3)
. I $G(^ACDCS(ACD1,1,PRVCR,0))=ACDGVER S ACDOK=1
K PRVCR
Q
H ;EP Header
D H^ACDWSTA2
Q
;
F ;Form Feed
Q:$D(DIRUT)
I $Y+4>IOSL D F^ACDWUTL D:'$D(DIRUT) H
Q
EOJ ;EP - EOJ FOR XBDBQUE
K ; for gotos in this routine
D ^ACDWK
Q
ACDWSTAF ;IHS/ADC/EDE/KML - STAFF REPORTS 10:19;
+1 ;;4.1;CHEMICAL DEPENDENCY MIS;;MAY 11, 1998
+2 ;//[ACD R6-SAR]
EN ;
+1 KILL DIRUT
+2 ;
+3 ;Initialize counter forTOT CLIENT SERVICE HOURS (ACDTH)
+4 ; TOT PREVENTION HOURS (ACDTHP)
+5 ; TOT CRISIS BRIEF HOURS (ACDTHOT)
+6 ; TOT CLIENT SERVICE VISITS (ACDCNUMT)
+7 ; TOT UNIQ CLIENTS SEEN (ACDCLIU)
+8 SET ACDTH=0
SET ACDTHP=0
SET ACDTHOT=0
SET ACDCNUMT=0
KILL ACDCLIU
+9 ;
+10 ;Initialize counter for total visits found on report
+11 SET ACDVNUM=0
+12 ;
+13 ;Set flag variable for tasking
+14 SET ACDWSTAF(1)=1
+15 ;
+16 ;Ask for only one provider
+17 KILL ACDGVER
+18 ;K DIC S DIC="^DIC(6,",DIC(0)="AEQ" D ^DIC Q:Y<0 S ACDGVER=+Y
+19 KILL DIC
SET DIC="^VA(200,"
SET DIC(0)="AEQ"
SET DIC("S")="I $D(^XUSEC(""PROVIDER"",+Y))"
DO ^DIC
IF Y<0
QUIT
SET ACDGVER=+Y
+20 IF '$DATA(ACDGVER)
SET ACDQUIT=1
QUIT
+21 ;
+22 ;Ask for whole report or a summary only.
+23 SET DIR(0)="S^1:PRINT FULL REPORT;2:PRINT SUMMARY REPORT"
DO ^DIR
IF X["^"!($DATA(DTOUT)!(X=""))
GOTO K
+24 KILL ACDSUMRP
IF Y=2
SET ACDSUMRP=2
+25 ;
+26 ;Ask for date range to gather data
+27 DO D^ACDWRQ
IF $DATA(ACDQUIT)
GOTO K
+28 DO HV^ACDWUTL
+29 ;
+30 ;Queue
+31 ; call to XBDBQUE
DO ^ACDWQ
+32 QUIT
+33 ;
L ;EP - FOR TASKMAN (XBDBQUE)
+1 QUIT
+2 ;
P ;EP - PRINT REPORT
+1 ; Order on visit i.e. ^ACDVIS
+2 KILL DIRUT
+3 USE IO
DO H
+4 SET ACDFR=$EXTRACT(ACDFR,1,5)_"00"
+5 FOR ACD=ACDFR-.01:0
SET ACD=$ORDER(^ACDVIS("B",ACD))
IF 'ACD!(ACD>ACDTO)
QUIT
FOR ACDV=0:0
SET ACDV=$ORDER(^ACDVIS("B",ACD,ACDV))
IF 'ACDV
QUIT
SET ACDDA=ACDV
DO ^ACDWVIS
IF ACD6DIG=ACDAUF
DO V1
IF $DATA(DIRUT)
QUIT
+6 ;
+7 ;Get prevention data
+8 DO ^ACDWSTA1
+9 IF $DATA(DIRUT)
QUIT
+10 ;
+11 IF $DATA(ACDSUMRP)
WRITE !,"S U M M A R Y O N L Y",!!
+12 WRITE !,"NOTE: THIS REPORT DOES 'NOT INCLUDE' ANY INTERVENTION DATA.",!!
+13 DO EN^ACDV4MES
+14 WRITE !!,"SEARCH CRITERIA IS THAT: THE PROVIDER NAME WAS ENTERED",!,"DURING DATA ENTRY INTO THE FIELD TITLED 'PROVIDER TO CREDIT WORKLOAD' FOR "
+15 WRITE !,"CONTACT TYPES OF CLIENT SERVICE AND PREVENTIONS."
+16 WRITE !!,"SEARCH CRITERIA IS THAT: FOR ALL OTHER CONTACT TYPES",!,"WHERE THERE IS NO FIELD CALLED 'PROVIDER TO CREDIT WORKLOAD', THE 'PROVIDER'",!,"FIELD IS USED TO FIND A MATCH.",!!
+17 WRITE !,"H O U R S W O R K - L O A D D A T A"
+18 DO F
WRITE !,"TOT HOURS FOR CLIENT SERVICE CONTACTS: ",?70,ACDTH
+19 DO F
WRITE !,"TOT HOURS FOR PREVENTION CONTACTS: ",?70,ACDTHP
+20 DO F
WRITE !,"TOT HOURS FOR CRISIS/BRIEF CONTACTS: ",?70,ACDTHOT
+21 WRITE !!,"V I S I T W O R K - L O A D D A T A"
+22 DO F
WRITE !,"TOT CLIENT VISITS: ",?70,ACDVNUM
+23 WRITE !,"(INCLUDES PREVENTION VISITS)",!
+24 DO F
WRITE !,"TOT CLIENT SERVICES:",?70,ACDCNUMT
+25 WRITE !,"(REMEMBER: MANY CLIENTS SERVICES MAY BELONG TO THE SAME VISIT)",!!
+26 DO F
WRITE !,"TOT UNIQ CLIENTS SEEN:",?70
SET ACDCLIU=0
FOR ACD=0:0
SET ACD=$ORDER(ACDCLIU(ACD))
IF 'ACD
QUIT
SET ACDCLIU=ACDCLIU+1
+27 WRITE ACDCLIU
+28 DO F^ACDWUTL
+29 WRITE @IOF
+30 QUIT
+31 ;
V1 ;
+1 ;
+2 ;If Contact is 'OT' get hours for grand total
+3 IF ACDCONTL="CRISIS/BRIEF INT"
IF ACDPROVP=ACDGVER
SET ACDOTHRS=$ORDER(^ACDIIF("C",ACDV,0))
Begin DoDot:1
+4 IF ACDOTHRS]""
SET ACDOTHRS=$PIECE(^ACDIIF(ACDOTHRS,0),U,6)
SET ACDTHOT=ACDTHOT+ACDOTHRS
End DoDot:1
+5 ;
+6 ;If contact is not a client service visit, then the provider for the
+7 ;visit must match the selected provider. All contacts except prevention
+8 ;and client service will have only one provider. Secondary providers
+9 ;may exist on preventions and client services.
+10 IF ACDCONTL'="CLIENT SERVICE"
IF ACDPROVP'=ACDGVER
QUIT
+11 ;
+12 ;
+13 ;Increment visit counter,unique client counter
+14 SET ACDVNUM=ACDVNUM+1
SET ACDCLIU(ACDDFNP)=""
+15 ;
+16 ;Not a client service/prevention so simply output visit information
+17 ;then quit
+18 IF ACDCONTL'="CLIENT SERVICE"
IF ACDPROVP=ACDGVER
DO F
IF $DATA(DIRUT)
QUIT
IF '$DATA(ACDSUMRP)
WRITE !,ACDVNUM,")",?5,ACDCLIV,?18,$EXTRACT(ACDPG,1,12),?31,ACDCONTL
IF ACDCONTL="CRISIS/BRIEF INT"
WRITE "/",ACDOTHRS
WRITE ?60,$EXTRACT(ACDDFN,1,19)
QUIT
+19 IF $DATA(DIRUT)
QUIT
+20 ;
+21 ;
+22 ;Initialize counter for number of client services the provider was
+23 ;involved in within the single visit. (ACDCNUM)
+24 ;
+25 ;Initialize the counter for grand total hours within the visit.
+26 SET (ACDOK,ACDCNUM,ACDVH)=0
+27 ;
+28 DO CK
+29 IF 'ACDOK
QUIT
+30 DO F
IF $DATA(DIRUT)
QUIT
IF '$DATA(ACDSUMRP)
WRITE !!,ACDVNUM,")",?5,ACDCLIV,?18,$EXTRACT(ACDPG,1,12),?31,ACDCONTL,?60,$EXTRACT(ACDDFN,1,19),!!?14,"Primary Provider: ",?40,$SELECT($DATA(^VA(200,ACDPROVP,0)):$PIECE(^VA(200,ACDPROVP,0),U),1:"UNKNOWN")
+31 IF $DATA(DIRUT)
QUIT
+32 ;
+33 ;F ACD1=0:0 S ACD1=$O(^ACDCS("C",ACDV,ACD1)) Q:'ACD1 I $D(^ACDCS(ACD1,1,ACDGVER,0)) S ACDDA=ACD1 D ^ACDWCS Q:$D(DIRUT) D V2 Q:$D(DIRUT)
+34 ; replace above line (BUG fix). Needed to retrieve the ptr multiple
+35 ; for the provider(s) to credit workload (bug fix) since the ptr is
+36 ; not always equal to the provider ien which the replaced logic assumes
+37 FOR ACD1=0:0
SET ACD1=$ORDER(^ACDCS("C",ACDV,ACD1))
IF 'ACD1
QUIT
IF $DATA(^ACDCS(ACD1,1,0))
Begin DoDot:1
+38 SET PRVCR=$PIECE(^ACDCS(ACD1,1,0),U,3)
+39 IF $GET(^ACDCS(ACD1,1,PRVCR,0))=ACDGVER
SET ACDDA=ACD1
DO ^ACDWCS
IF $DATA(DIRUT)
QUIT
DO V2
IF $DATA(DIRUT)
QUIT
End DoDot:1
+40 KILL PRVCR
+41 IF $DATA(DIRUT)
QUIT
+42 DO F
IF $DATA(DIRUT)
QUIT
IF '$DATA(ACDSUMRP)
WRITE !?14,"TOT HOURS FOR VISIT: ",?40,ACDVH,!
+43 QUIT
V2 ;
+1 SET ACDCNUM=ACDCNUM+1
SET ACDCNUMT=ACDCNUMT+1
+2 DO F
IF '$DATA(ACDSUMRP)
WRITE !?8,ACDCNUM,")",?14,"Provider(s) credited: ",?40,$SELECT($DATA(^VA(200,ACDGVER,0)):$PIECE(^VA(200,ACDGVER,0),U),1:"UNKNOWN")
+3 DO F
IF '$DATA(ACDSUMRP)
WRITE !?14,"DAY",?40,ACDDAY
+4 DO F
IF '$DATA(ACDSUMRP)
WRITE !?14,"SERVICE",?40,ACDSVAC
+5 DO F
IF '$DATA(ACDSUMRP)
WRITE !?14,"LOCATION",?40,ACDLOTY
+6 DO F
IF '$DATA(ACDSUMRP)
WRITE !?14,"HOUR",?40,ACDHOUR
+7 SET ACDTH=ACDTH+ACDHOUR
SET ACDVH=ACDVH+ACDHOUR
+8 QUIT
CK ;
+1 ;See if provider was involved with any of the client services. If so,
+2 ;set ok to 1 and now I can print out the visit data with the
+3 ;primary provider knowing the primary provider may not be the selected
+4 ;provider
+5 SET ACDOK=0
+6 IF ACDPROVP=ACDGVER
SET ACDOK=1
QUIT
+7 ;F ACD1=0:0 S ACD1=$O(^ACDCS("C",ACDV,ACD1)) Q:'ACD1 S ACDDA=ACD1 D ^ACDWCS I $D(^ACDCS(ACD1,1,ACDGVER,0)) S ACDOK=1
+8 ; replace above line (BUG fix). Needed to retrieve the ptr multiple
+9 ; for the provider(s) to credit workload (bug fix) since the ptr is
+10 ; not always equal to the provider ien which the replaced logic assumes
+11 FOR ACD1=0:0
SET ACD1=$ORDER(^ACDCS("C",ACDV,ACD1))
IF 'ACD1
QUIT
SET ACDDA=ACD1
DO ^ACDWCS
IF $DATA(^ACDCS(ACD1,1,0))
Begin DoDot:1
+12 SET PRVCR=$PIECE(^ACDCS(ACD1,1,0),U,3)
+13 IF $GET(^ACDCS(ACD1,1,PRVCR,0))=ACDGVER
SET ACDOK=1
End DoDot:1
+14 KILL PRVCR
+15 QUIT
H ;EP Header
+1 DO H^ACDWSTA2
+2 QUIT
+3 ;
F ;Form Feed
+1 IF $DATA(DIRUT)
QUIT
+2 IF $Y+4>IOSL
DO F^ACDWUTL
IF '$DATA(DIRUT)
DO H
+3 QUIT
EOJ ;EP - EOJ FOR XBDBQUE
K ; for gotos in this routine
+1 DO ^ACDWK
+2 QUIT
