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

SCMCMHU1.m

Go to the documentation of this file. 
  1. SCMCMHU1 ;BP-CIOFO/LLH - Mental Health Reports (cont.) ; 02/08/2012 09:15 AM
  1.  ;;5.3;Scheduling;**589**;AUG 13, 1993;Build 41
  1.  ;
  1.  ; created to use with new Mental Health reports
  1.  ;
  1. PRMTT ;Prompt for team.
  1.  ;
  1.  ;This subroutine was copied from SCRPU1 and modified to return MH teams. Additionally, 
  1.  ;the code was modified to set all mental health teams into the VAUTT array if all was 
  1.  ;selected. This was done so that all other routines could be used to process the data
  1.  ;
  1.  I '$D(VAUTD) G ERR
  1.  S VAUTVB="VAUTT",DIC="^SCTM(404.51,",VAUTNI=2,VAUTSTR="Team",DIC("B")=""
  1.  ;screen for mental health teams
  1.  S DIC("S")="I $$MHTEAM^SCMCMHU1(Y)"
  1.  G FIRST
  1.  ;
  1. MHTEAM(IEN) ; Screen for mental health teams only
  1.  ; input: IEN - internal record number for the team
  1.  ;output: VALID - 1 if a valid mental health team, 0 if not
  1.  ;
  1.  N VALID
  1.  I $P(^SD(403.47,$P(^SCTM(404.51,IEN,0),U,3),0),U,1)'="MENTAL HEALTH TREATMENT" Q 0
  1.  I $D(VAUTD(+$P(^SCTM(404.51,IEN,0),U,7))) Q 1
  1.  I VAUTD=1 Q 1
  1.  Q 0
  1.  ;
  1.  ;
  1. PRACT ; Patch 589, Change Practitioner to Clinician/Provider
  1.  ;Prompt for One (set VAUTPO) or One,Many,All,None Practitioner(s)
  1.  I '$D(VAUTT) G ERR
  1.  S VAUTVB="VAUTP",VAUTSTR="Clinician/Provider",VAUTNI=2,DIC="^VA(200,"
  1.  S DIC("S")="I $$PRACS^SCRPU1()"
  1.  G FIRST
  1.  ;
  1. PRACS() ;Practitioner screen - off of team selection
  1.  N EN,STOP,NODE,TEAM
  1.  S EN="",STOP=0
  1.  I '$D(^SCTM(404.52,"C",+Y)) Q 0
  1.  ;Position Assignment History file
  1.  F  S EN=$O(^SCTM(404.52,"C",+Y,EN)) Q:EN=""!(STOP)  D
  1.  .I '$D(^SCTM(404.52,EN)) Q
  1.  .S NODE=$G(^SCTM(404.52,EN,0))
  1.  .S TEAM=+$P($G(^SCTM(404.57,$P(NODE,"^"),0)),"^",2)
  1.  .I $P(NODE,"^",4),$D(VAUTT(TEAM)) S STOP=1
  1.  .I VAUTT=1 S STOP=1
  1.  Q STOP
  1.  ; 
  1.  ;PRACT ; patch 589 - added subroutine, changed Practitioner to Clinician/Provider 
  1.  ; ;Prompt for One (set VAUTPO) or One,Many,All,None Clinician/Provider(s)
  1.  ; I '$D(VAUTT) G ERR
  1.  ;S VAUTVB="VAUTP",VAUTSTR="Clinician/Provider(s)",VAUTNI=2,DIC="^VA(200,"
  1.  ;S DIC("S")="I $$PRACS^SCMCMHU1()"
  1.  ;G FIRST
  1.  ;
  1.  ;PRACS() ;Practitioner screen - off of team selection
  1.  ;N EN,STOP,NODE,TEAM
  1.  ;S EN="",STOP=0
  1.  ;I '$D(^SCTM(404.52,"C",+Y)) Q 0
  1.  ;Position Assignment History file
  1.  ;F S EN=$O(^SCTM(404.52,"C",+Y,EN)) Q:EN=""!(STOP) D
  1.  ;.I '$D(^SCTM(404.52,EN)) Q
  1.  ;.S NODE=$G(^SCTM(404.52,EN,0))
  1.  ;.S TEAM=+$P($G(^SCTM(404.57,$P(NODE,"^"),0)),"^",2)
  1.  ;.I $P(NODE,"^",4),$D(VAUTT(TEAM)) S STOP=1
  1.  ;.I VAUTT=1 S STOP=1
  1.  ;Q STOP
  1.  ; 
  1. FIRST ;
  1.  S DIC(0)="EQMNZ",DIC("A")="Select "_VAUTSTR_": " K @VAUTVB
  1.  S (@VAUTVB,Y)=0
  1.  ;
  1. REDO W !,DIC("A") R X:DTIME G ERR:(X="^")!'$T D:X["?"!(X=""&('$G(SCOKNULL))) HELP
  1.  G:$G(SCOKNULL)&(X="") QUIT
  1.  ;patch 589 call to GETALL is to get all Mental health teams, also must set
  1.  ;VAUTVB if Clinican/Provider = All
  1.  I X="A"!(X="ALL")&'$D(VAUTNA) D  G QUIT
  1.  .I VAUTVB="VAUTT" D GETALL Q
  1.  .I VAUTVB="VAUTP" S @VAUTVB=1 Q
  1.  .Q
  1.  S DIC("A")="Select another "_VAUTSTR_": " D ^DIC G:Y'>0 FIRST D SET
  1.  I '$D(VAUTPO) F VAI=1:0:19 W !,DIC("A") R X:DTIME G ERR:(X="")!(X="^")!'$T K Y D HELP:X["?" S:$E(X)="-" VAUTX=X,X=$E(VAUTX,2,999) D ^DIC I Y>0 D SET G:VAX REDO S:'VAERR VAI=VAI+1
  1.  G QUIT
  1.  ;
  1. SET S VAX=0 I $D(VAUTX) S J=$S(VAUTNI=2:+Y,1:$P(Y(0),"^")) K VAUTX S VAERR=$S($D(@VAUTVB@(J)):0,1:1) W $S('VAERR:"...removed from list...",1:"...not on list...can't remove") Q:VAERR  S VAI=VAI-1 K @VAUTVB@(J) S:$O(@VAUTVB@(0))']"" VAX=1 Q
  1.  S VAERR=0 I $S($D(@VAUTVB@($P(Y(0),U))):1,$D(@VAUTVB@(+Y)):1,1:0) W !?3,*7,"You have already selected that ",VAUTSTR,". Try again." S VAERR=1
  1.  S @VAUTVB@(+Y)=$P(Y(0),U)
  1.  Q
  1.  ;
  1. ERR S Y=-1 I $O(@VAUTVB@(0))="" K @VAUTVB I X="^" S SCUP=""
  1. QUIT S:'$D(Y) Y=1
  1.  I $D(@VAUTVB),VAUTSTR="Team",@VAUTVB=1 D:'$G(DGQUIET) EN^DDIOL("All Teams selected, this report may take some time...","","!,?10")
  1.  K DIC,J,VAERR,VAI,VAJ,VAJ1,VAX,VAUTNI,VAUTSTR,VAUTVB,X
  1.  Q
  1.  ;
  1. HELP ; 
  1.  W:'$D(VAUTNA) !,"ENTER:",!?5,"- A or ALL for all Mental Health ",VAUTSTR,"s, or"
  1.  W !?5,"- Select individual Mental Health "_VAUTSTR W:'$D(VAUTPO) " -- limit 20"
  1.  W !?5,"Imprecise selections will yield an additional prompt."
  1.  I $O(@VAUTVB@(0))]"" W !?5,"- An entry preceeded by a minus [-] sign to remove entry from list."
  1.  I $O(@VAUTVB@(0))]"" W !,"NOTE, you have already selected:" S VAJ=0 F VAJ1=0:0 S VAJ=$O(@VAUTVB@(VAJ)) Q:VAJ=""  W !?8,$S(VAUTNI=1:VAJ,1:@VAUTVB@(VAJ))
  1.  Q
  1.  ;
  1. GETALL ; user selected all MH teams, rather than manipulate other routines
  1.  ; will set all the mental health teams for the division into the team array
  1.  ;
  1.  ; input: none
  1.  ;output: VAUTT array
  1.  ;
  1.  K @VAUTVB
  1.  S @VAUTVB=0
  1.  N CNT,MHT,STR
  1.  S (CNT,MHT)=0
  1.  F  S MHT=$O(^SCTM(404.51,MHT)) Q:(MHT'>0)!(CNT>20)  D
  1.  .S STR=$G(^SCTM(404.51,MHT,0))
  1.  .I $P(^SD(403.47,$P(STR,U,3),0),U,1)'="MENTAL HEALTH TREATMENT" Q
  1.  .I VAUTD=1!($D(VAUTD(+$P(STR,U,7)))) S @VAUTVB@(MHT)=$P(STR,U,1),CNT=CNT+1
  1.  Q
  1. DELOUT() ; ask user if Summary should be in a delimited output format
  1.  ; input - none
  1.  ;output - 1 if delimited output
  1.  ; 0 if a regular report format is desired
  1.  ;
  1.  N X,DTOUT,DUOUT,DIROUT,Y
  1.  S DIR("A")="Should the Summary be a '^' delimited format?",DIR("B")="N"
  1.  S DIR("?")="Enter 'Y' for '^' output, 'N' for a formatted report."
  1.  S DIR(0)="Y"
  1.  D ^DIR
  1.  ;I $D(DTOUT)!(X="") S Y=$S(DIR("B")="Y":1,1:0)
  1.  I $D(DUOUT)!($D(DIROUT)) S Y=-1
  1.  K DIR
  1.  Q +Y
  1.  ;
  1.  ;patch 589 - copied from SORT^SCRPU2 and modified to change Practitioner with
  1.  ; Clinician
  1. SORT() ;
  1.  ;Prompt for sorting by Division, Team, Clinician or Division, Practitioner, Team
  1.  ;
  1. EN1 N X
  1.  W !,"Sort By:",!?10,"[1] Division, Team, Clinician",!?10,"[2] Division, Clinician, Team"
  1.  W !?10,"[3] Clinician,Associated Clinic"
  1.  W !!,"Select 1 or 2 or 3: "
  1.  R X:DTIME
  1.  I (X="^")!'$T Q 0
  1.  I (X'="1")&(X'="2")&(X'=3) D HLP3 G EN1
  1.  I (X["?")!(X="") D HLP3 G EN1
  1.  Q X
  1. HLP3 ;
  1.  ;help prompt
  1.  W !,"Enter: ",!?5,"- 1 to sort by Division, Team, Clinician "
  1.  W !?10,"- 2 to sort by Division, Clinician, Team"
  1.  Q