Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ACDWSTAF

ACDWSTAF.m

Go to the documentation of this file. 
  1. ACDWSTAF ;IHS/ADC/EDE/KML - STAFF REPORTS 10:19; 
  1.  ;;4.1;CHEMICAL DEPENDENCY MIS;;MAY 11, 1998
  1.  ;//[ACD R6-SAR]
  1. EN ;
  1.  K DIRUT
  1.  ;
  1.  ;Initialize counter forTOT CLIENT SERVICE HOURS (ACDTH)
  1.  ;                      TOT PREVENTION HOURS   (ACDTHP)
  1.  ;                      TOT CRISIS BRIEF HOURS (ACDTHOT)
  1.  ;                      TOT CLIENT SERVICE VISITS (ACDCNUMT)
  1.  ;                      TOT UNIQ CLIENTS SEEN (ACDCLIU)
  1.  S ACDTH=0,ACDTHP=0,ACDTHOT=0,ACDCNUMT=0 K ACDCLIU
  1.  ;
  1.  ;Initialize counter for total visits found on report
  1.  S ACDVNUM=0
  1.  ;
  1.  ;Set flag variable for tasking
  1.  S ACDWSTAF(1)=1
  1.  ;
  1.  ;Ask for only one provider
  1.  K ACDGVER
  1.  ;K DIC S DIC="^DIC(6,",DIC(0)="AEQ" D ^DIC Q:Y<0  S ACDGVER=+Y
  1.  K DIC S DIC="^VA(200,",DIC(0)="AEQ",DIC("S")="I $D(^XUSEC(""PROVIDER"",+Y))" D ^DIC Q:Y<0  S ACDGVER=+Y
  1.  I '$D(ACDGVER) S ACDQUIT=1 Q
  1.  ;
  1.  ;Ask for whole report or a summary only.
  1.  S DIR(0)="S^1:PRINT FULL REPORT;2:PRINT SUMMARY REPORT" D ^DIR G:X["^"!($D(DTOUT)!(X="")) K
  1.  K ACDSUMRP I Y=2 S ACDSUMRP=2
  1.  ;
  1.  ;Ask for date range to gather data
  1.  D D^ACDWRQ G:$D(ACDQUIT) K
  1.  D HV^ACDWUTL
  1.  ;
  1.  ;Queue
  1.  D ^ACDWQ ;        call to XBDBQUE
  1.  Q
  1.  ;
  1. L ;EP - FOR TASKMAN (XBDBQUE)
  1.  Q
  1.  ;
  1. P ;EP - PRINT REPORT
  1.  ; Order on visit i.e. ^ACDVIS
  1.  K DIRUT
  1.  U IO D H
  1.  S ACDFR=$E(ACDFR,1,5)_"00"
  1.  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)
  1.  ;
  1.  ;Get prevention data
  1.  D ^ACDWSTA1
  1.  Q:$D(DIRUT)
  1.  ;
  1.  I $D(ACDSUMRP) W !,"S U M M A R Y   O N L Y",!!
  1.  W !,"NOTE: THIS REPORT DOES 'NOT INCLUDE' ANY INTERVENTION DATA.",!!
  1.  D EN^ACDV4MES
  1.  W !!,"SEARCH CRITERIA IS THAT: THE PROVIDER NAME WAS ENTERED",!,"DURING DATA ENTRY INTO THE FIELD TITLED 'PROVIDER TO CREDIT WORKLOAD' FOR "
  1.  W !,"CONTACT TYPES OF CLIENT SERVICE AND PREVENTIONS."
  1.  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.",!!
  1.  W !,"H O U R S   W O R K - L O A D   D A T A"
  1.  D F W !,"TOT HOURS FOR CLIENT SERVICE CONTACTS: ",?70,ACDTH
  1.  D F W !,"TOT HOURS FOR PREVENTION CONTACTS: ",?70,ACDTHP
  1.  D F W !,"TOT HOURS FOR CRISIS/BRIEF CONTACTS: ",?70,ACDTHOT
  1.  W !!,"V I S I T   W O R K - L O A D   D A T A"
  1.  D F W !,"TOT CLIENT VISITS: ",?70,ACDVNUM
  1.  W !,"(INCLUDES PREVENTION VISITS)",!
  1.  D F W !,"TOT CLIENT SERVICES:",?70,ACDCNUMT
  1.  W !,"(REMEMBER: MANY CLIENTS SERVICES MAY BELONG TO THE SAME VISIT)",!!
  1.  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
  1.  W ACDCLIU
  1.  D F^ACDWUTL
  1.  W @IOF
  1.  Q
  1.  ;
  1. V1 ;
  1.  ;
  1.  ;If Contact is 'OT' get hours for grand total
  1.  I ACDCONTL="CRISIS/BRIEF INT",ACDPROVP=ACDGVER S ACDOTHRS=$O(^ACDIIF("C",ACDV,0)) D
  1.  . I ACDOTHRS]"" S ACDOTHRS=$P(^ACDIIF(ACDOTHRS,0),U,6),ACDTHOT=ACDTHOT+ACDOTHRS
  1.  ;
  1.  ;If contact is not a client service visit, then the provider for the
  1.  ;visit must match the selected provider. All contacts except prevention
  1.  ;and client service will have only one provider. Secondary providers
  1.  ;may exist on preventions and client services.
  1.  I ACDCONTL'="CLIENT SERVICE",ACDPROVP'=ACDGVER Q
  1.  ;
  1.  ;
  1.  ;Increment visit counter,unique client counter
  1.  S ACDVNUM=ACDVNUM+1 S ACDCLIU(ACDDFNP)=""
  1.  ;
  1.  ;Not a client service/prevention so simply output visit information
  1.  ;then quit
  1.  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
  1.  Q:$D(DIRUT)
  1.  ;
  1.  ;
  1.  ;Initialize counter for number of client services the provider was
  1.  ;involved in within the single visit. (ACDCNUM)
  1.  ;
  1.  ;Initialize the counter for grand total hours within the visit.
  1.  S (ACDOK,ACDCNUM,ACDVH)=0
  1.  ;
  1.  D CK
  1.  Q:'ACDOK
  1.  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")
  1.  Q:$D(DIRUT)
  1.  ;
  1.  ;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)
  1.  ; replace above line (BUG fix). Needed to retrieve the ptr multiple    
  1.  ; for the provider(s) to credit workload (bug fix) since the ptr is
  1.  ; not always equal to the provider ien which the replaced logic assumes
  1.  F ACD1=0:0 S ACD1=$O(^ACDCS("C",ACDV,ACD1)) Q:'ACD1  I $D(^ACDCS(ACD1,1,0)) D
  1.  . S PRVCR=$P(^ACDCS(ACD1,1,0),U,3)
  1.  . I $G(^ACDCS(ACD1,1,PRVCR,0))=ACDGVER S ACDDA=ACD1 D ^ACDWCS Q:$D(DIRUT)  D V2 Q:$D(DIRUT) 
  1.  K PRVCR
  1.  Q:$D(DIRUT)
  1.  D F Q:$D(DIRUT)  I '$D(ACDSUMRP) W !?14,"TOT HOURS FOR VISIT: ",?40,ACDVH,!
  1.  Q
  1. V2 ;
  1.  S ACDCNUM=ACDCNUM+1,ACDCNUMT=ACDCNUMT+1
  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")
  1.  D F I '$D(ACDSUMRP) W !?14,"DAY",?40,ACDDAY
  1.  D F I '$D(ACDSUMRP) W !?14,"SERVICE",?40,ACDSVAC
  1.  D F I '$D(ACDSUMRP) W !?14,"LOCATION",?40,ACDLOTY
  1.  D F I '$D(ACDSUMRP) W !?14,"HOUR",?40,ACDHOUR
  1.  S ACDTH=ACDTH+ACDHOUR,ACDVH=ACDVH+ACDHOUR
  1.  Q
  1. CK ;
  1.  ;See if provider was involved with any of the client services. If so,
  1.  ;set ok to 1 and now I can print out the visit data with the
  1.  ;primary provider knowing the primary provider may not be the selected
  1.  ;provider
  1.  S ACDOK=0
  1.  I ACDPROVP=ACDGVER S ACDOK=1 Q
  1.  ;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
  1.  ; replace above line (BUG fix). Needed to retrieve the ptr multiple    
  1.  ; for the provider(s) to credit workload (bug fix) since the ptr is
  1.  ; not always equal to the provider ien which the replaced logic assumes
  1.  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
  1.  . S PRVCR=$P(^ACDCS(ACD1,1,0),U,3)
  1.  . I $G(^ACDCS(ACD1,1,PRVCR,0))=ACDGVER S ACDOK=1
  1.  K PRVCR
  1.  Q
  1. H ;EP Header
  1.  D H^ACDWSTA2
  1.  Q
  1.  ;
  1. F ;Form Feed
  1.  Q:$D(DIRUT)
  1.  I $Y+4>IOSL D F^ACDWUTL D:'$D(DIRUT) H
  1.  Q
  1. EOJ ;EP - EOJ FOR XBDBQUE
  1. K ; for gotos in this routine
  1.  D ^ACDWK
  1.  Q