SCMCMHPP ;BP-CIOFO/LLH - MH Clinician's Patients ; 2/7/2012 10:00am
;;5.3;Scheduling;**589**;AUG 13, 1993;Build 41
;
;Routine copied from SCRPPAT and modified for Mental Health.
;Specific modification is to screen for Mental Health teams and
;if all selected it will be all MH teams
;as well as outputting an '^' delimited summary report.
;
PROMPTS ;
;Prompt for division, team, role, clinician, summary only and
;print device
;
N QTIME,PRNT,VAUTP,Y,VAUTD,VAUTT,VAUTR,VAUTS,SORT,NUMBER,VADEL
K SCUP
S QTIME=""
W ! D INST^SCRPU1 I Y=-1 G ERR
;Patch 589 - screen teams for Mental Health only
W ! K Y D PRMTT^SCMCMHU1 I '$D(VAUTT) G ERR
W ! K Y D ROLE^SCRPU1 I '$D(VAUTR) G ERR
W ! D PRACT^SCMCMHU1 I '$D(VAUTP) G ERR
W ! S VAUTS=$$SUMM^SCRPU2() I VAUTS<0 G ERR
;Patch 589 - if summary report being requested, ask for ^ delimited output
S:'VAUTS VADEL=0
I VAUTS W ! S VADEL=$$DELOUT^SCMCMHU1() I VADEL<0 G ERR
S SORT=""
I VADEL=1 S SORT=1
I SORT'=1 W ! S SORT=$$SORT^SCMCMHU1() I SORT<1 G ERR
S PRNT=$$PDEVICE^SCRPU3()
I PRNT=-1 G ERR
I PRNT["Q;" S QTIME=$$GETTIME^SCRPU3()
I QTIME=-1 G ERR
I PRNT'?1"Q;".E S PRNT="Q;"_PRNT
;Patch 589 - added VADEL
S NUMBER=$$ENTRY2(.VAUTD,.VAUTT,.VAUTR,.VAUTP,VAUTS,SORT,PRNT,QTIME,VADEL)
I NUMBER>0 W !!,"Print queued, task number: ",NUMBER
Q
;
ENTRY2(INST,TEAM,ROLE,PRACT,SUMM,SORT,IOP,ZTDTH,VADEL) ;
;Second entry point for GUI to use
;Input Parameters:
;INST - institutions selected (variable and array)
;TEAM - teams selected (variable and array)
;ROLE - roles selected (variable and array)
;PRACT - clinicians selected (ien new person file) - (variable and array)
;SUMM - summary info? y/n (1-yes/0-no) yes don't print patient data
;SORT - sort criteria (1-d,t,p/2-d,p,t)
;IOP - print device
;ZTDTH - queue time (optional)
;
;validate parameters
I '$D(INST)!'$D(TEAM)!'$D(ROLE)!'$D(PRACT)!'$D(SUMM)!'$D(SORT)!'$D(IOP)!(IOP="")!'$D(VADEL) Q
;
N NUMBER
S IOST=$P(IOP,"^",2),IOP=$P(IOP,"^")
I IOP?1"Q;".E S IOP=$P(IOP,"Q;",2)
I IOST?1"C-".E D QENTRY G RET
I ZTDTH="" S ZTDTH=$H
S ZTRTN="QENTRY^SCMCMHPP"
;patch 589 changed clinician's to Clinician's
S ZTDESC="MH Clinician's Patients",ZTIO=IOP
N II
;Patch 589 added VADEL
F II="IOSL","INST","INST(","TEAM","TEAM(","ROLE","ROLE(","PRACT(","PRACT","SUMM","IOP","SORT","VADEL" S ZTSAVE(II)=""
D ^%ZTLOAD
RET S NUMBER=0
I $D(ZTSK) S NUMBER=ZTSK
D EXIT1
Q NUMBER
;
QENTRY ;
;driver entry point
;patch 589 changed clinician's to Clinician's
S TITL="MH Clinician's Patients"
I SUMM S TITL=TITL_" Summary Report"
S STORE="^TMP("_$J_",""SCRPPAT"")"
K @STORE
S @STORE=0
;Patch 589, changed from ^SCRPPAT2 to ^SCMCMHP2
D DRIVE^SCMCMHP2
I $O(@STORE@(0))="" S NODATA=$$NODATA^SCRPU3(TITL)
;Patch 589 - if output is sent to a delimited format, use selected device
; but do special formating
I '$D(NODATA)&VADEL D SPECFMT(STORE)
I '$D(NODATA)&'VADEL D PRINTIT(STORE,IOP,TITL,SORT)
D EXIT2
Q
;
ERR ;
EXIT1 ;
K ZTDTH,ZTRTN,ZTDESC,ZTSK,ZTIO,ZTSAVE,VAUTD,VAUTT,VAUTP,VAUTR
K SCUP,VAUTS,SORT
Q
;
EXIT2 ;
K @STORE
K STORE,TITL,IOP,PRACT,INST,TEAM,ROLE,SORT,SUMM,NODATA,STOP
Q
;
PRINTIT(STORE,IOP,TITL,SORT) ; Print All Data
;STORE - global location of data
;IOP - device to print to
;TITL - title of report
;SORT - sort order 1-div,team,clinician/2-div,clinician,team
;
N PAGE
S PAGE=1,STOP=0 W:$E(IOST)="C" @IOF
N SEC1,SEC2,SEC2,SEC3,SEC4,ST1,ST2,ST3,ST4
I SORT=1 S SEC1="""T""",SEC2="""P""",SEC3="""TN""",SEC4="""PN"""
I SORT=2!(SORT=3) S SEC1="""P""",SEC2="""T""",SEC3="""PN""",SEC4="""TN"""
N SEC,TRD,INS,INAME,SECN,TRDN,PT,FIRST
S (INAME,INS)="",FIRST=1
F S INAME=$O(@STORE@("I",INAME)) Q:INAME=""!(STOP) D
.S INS=$O(@STORE@("I",INAME,""))
.Q:INS=""!STOP
.D S
D S1
Q
S ;
S SECN="",ST1=$E(STORE,1,($L(STORE)-1))_","_SEC1_")"
F S SECN=$O(@ST1@(INS,SECN)) Q:SECN=""!(STOP) D
.S SEC=$O(@ST1@(INS,SECN,"")) ;ien of team or clinician
.Q:SEC=""
.S ST3=$E(STORE,1,($L(STORE)-1))_","_SEC3_")"
.S TRDN="",ST2=$E(STORE,1,($L(STORE)-1))_","_SEC2_")"
.F S TRDN=$O(@ST2@(INS,TRDN)) Q:TRDN=""!(STOP) D
..S TRD=$O(@ST2@(INS,TRDN,"")) ;ien of team or clinician
..Q:TRD=""
..;have first team and first clinician ien
..S ST4=$E(STORE,1,($L(STORE)-1))_","_SEC4_")"
..D PRNT(ST4,ST3,SEC3,.PAGE,TITL,INS,SEC,TRD) Q:STOP
Q
S1 I $E(IOST)="C",'STOP W ! N DIR S DIR(0)="E" D ^DIR S STOP=Y'=1
I 'STOP,SUMM=0 S (FIRST,SUMM)=1,TITL=TITL_" Summary Report" W @IOF D PRINTIT(STORE,$G(IOP),TITL,SORT)
Q
;
PRNT(ST4,ST3,SEC3,PAGE,TITL,INS,SEC,TRD) ;
;
N POS
I (SEC3="""PN""")&($D(@ST3@(INS,SEC,TRD))) D
.;get each position for clinician
.N MORE S POS="",MORE=0
.F S POS=$O(@ST3@(INS,SEC,TRD,POS)) Q:POS=""!(STOP) D
..I 'SUMM I SORT=3 D Q
...;I MORE ;S FIRST=0
...K @STORE@("H1") D SHEAD
...I 'MORE I (PAGE=1)!(IOST?1"C-".E) D TITLE^SCRPU3(.PAGE,TITL)
...;patch 589 -- modified to print, Clinician rather than Practitioner
...I 'MORE N STR S STR=$G(@ST3@(INS,SEC,TRD,POS)) W !," Clinician:"_$P(STR,":",2),!
...;I 'MORE W !,$G(@ST3@(INS,SEC,TRD,POS)),!
...D PAT^SCRPPAT3(INS,SEC,TRD,SEC3,ST3,ST4,POS) S MORE=1
...I $O(@ST3@(INS,SEC,TRD,POS))="" D
....I (IOST?1"C-".E) D HOLD(.PAGE,"") S PAGE=PAGE+1 Q:STOP
....I (IOST'?1"C-".E) D NEWP1^SCRPU3(.PAGE,TITL) Q:STOP
..I SUMM D Q
...I FIRST D TITLE^SCRPU3(.PAGE,TITL),SHEAD,SSH S FIRST=0
...I (IOST'?1"C-".E),$Y>(IOSL-4) D NEWP1^SCRPU3(.PAGE,TITL) Q:STOP D SSH
...I (IOST?1"C-".E),$Y>(IOSL-6) D HOLD^SCRPU3(.PAGE,TITL) Q:STOP D SSH
...W !,@STORE@("SUM0",INS,SEC,TRD,POS)
...W ?72,$J($G(@STORE@("TOTAL",INS,SEC,TRD,POS)),8)
...Q
..Q:SORT=3
..I FIRST D:'MORE TITLE^SCRPU3(.PAGE,TITL) D SHEAD
..;patch 589 - commented W commands out, it wrote the division header incorrectly
..I (IOST'?1"C-".E),'SUMM,'FIRST D NEWP1^SCRPU3(.PAGE,TITL) ;W:'STOP !,$G(@STORE@(INS))
..I (IOST?1"C-".E),'SUMM,'FIRST D HOLD^SCRPU3(.PAGE,TITL) ;W:'STOP !,$G(@STORE@(INS))
..Q:STOP S FIRST=1 I 'MORE S FIRST=0
..;patch 589 - modified to print, Clinician rather than Practitioner
..N STR S STR=$G(@ST3@(INS,SEC,TRD,POS)) W !," Clinician:"_$P(STR,":",2)
..;W !,$G(@ST3@(INS,SEC,TRD,POS)) ;write clinician (sort 1)
..I $L($G(@ST3@(INS,SEC,TRD,POS,"PRCP"))) W !,@ST3@(INS,SEC,TRD,POS,"PRCP")
..I $G(SORT)'=3 W !,$G(@ST4@(INS,TRD)) ;write team (sort 2)
..W !,$G(@STORE@(INS))
..;$o through patients for clinician on team
..D PAT^SCRPPAT3(INS,SEC,TRD,SEC3,ST3,ST4,POS) Q:STOP
..I (IOST'?1"C-".E),$Y>(IOSL-4) D NEWP1^SCRPU3(.PAGE,TITL) Q:STOP
..I (IOST?1"C-".E),$Y>(IOSL-6) D HOLD^SCRPU3(.PAGE,TITL) Q:STOP
..D TOTAL1^SCRPPAT3(INS,SEC,TRD,POS) ;print team/clinician total
;
I (SEC3="""TN""")&($D(@ST4@(INS,TRD,SEC))) D
.S POS=""
.F S POS=$O(@ST4@(INS,TRD,SEC,POS)) Q:POS=""!(STOP) D
..I SUMM D Q
...I FIRST D TITLE^SCRPU3(.PAGE,TITL),SHEAD,SSH S FIRST=0
...I (IOST'?1"C-".E),$Y>(IOSL-4) D NEWP1^SCRPU3(.PAGE,TITL) Q:STOP D SSH
...I (IOST?1"C-".E),$Y>(IOSL-6) D HOLD^SCRPU3(.PAGE,TITL) Q:STOP D SSH
...W !,@STORE@("SUM0",INS,TRD,SEC,POS)
...W ?72,$J(@STORE@("TOTAL",INS,TRD,SEC,POS),8)
...Q
..I FIRST D TITLE^SCRPU3(.PAGE,TITL),SHEAD
..I (IOST'?1"C-".E),'SUMM,'FIRST D NEWP1^SCRPU3(.PAGE,TITL)
..I (IOST?1"C-".E),'SUMM,'FIRST D HOLD^SCRPU3(.PAGE,TITL)
..Q:STOP S FIRST=0
..I $G(SORT)'=3 W !,$G(@ST3@(INS,SEC)) ;write team (sort 1)
..W !,$G(@STORE@(INS))
..;patch 589 - modified to print, Clinician rather than Practitioner
..I $G(SORT)'=3 N STR D
...S STR=$G(@ST4@(INS,TRD,SEC,POS)) W !," Clinician:"_$P(STR,":",2)
..;I $G(SORT)'=3 W !,$G(@ST4@(INS,TRD,SEC,POS)) ;write clinician (sort 2)
..I $L($G(@ST4@(INS,TRD,SEC,POS,"PRCP"))) W !,@ST4@(INS,TRD,SEC,POS,"PRCP")
..W !
..;$o through patients for clinician on team
..D PAT^SCRPPAT3(INS,SEC,TRD,SEC3,ST3,ST4,POS) Q:STOP
..I (IOST'?1"C-".E),$Y>(IOSL-4) D NEWP1^SCRPU3(.PAGE,TITL) Q:STOP
..I (IOST?1"C-".E),$Y>(IOSL-6) D HOLD^SCRPU3(.PAGE,TITL) Q:STOP
..D TOTAL1^SCRPPAT3(INS,SEC,TRD,POS) ;print team/clinician total
Q
;
SPECFMT(STORE) ; Patch 589 - format delimited output
;STORE - global location of data
;IOP - device to print to
;TITL - title of report
;SORT - sort order 1-div,team,clinician/2-div,clinician,team
;
N DATA,INS,POS,SEC,TRD
;Patch 589 changed Practitioner's to Clinician
W !,"Printed on: "_$$FMTE^XLFDT(DT,"5D")_U_"Clinician's Patients Summary Report"
W !,"Clinician"_U_"Position"_U_"Team"_U_"Patients Assigned"
S INS=0 F S INS=$O(@STORE@("SUM0",INS)) Q:INS'>0 D
.S SEC=0 F S SEC=$O(@STORE@("SUM0",INS,SEC)) Q:SEC'>0 D
..S TRD=0 F S TRD=$O(@STORE@("SUM0",INS,SEC,TRD)) Q:TRD'>0 D
...S POS=0 F S POS=$O(@STORE@("SUM0",INS,SEC,TRD,POS)) Q:POS'>0 D
....S DATA=@STORE@("SUM0",INS,SEC,TRD,POS)
....W !,$$FMTDATA(DATA)_U_$G(@STORE@("TOTAL",INS,SEC,TRD,POS))
Q
;
FMTDATA(DATA) ;
; patch 589, used to strip trailing spaces from the formated data
; input - DATA = formatted data, clinician, Position, Team and Patients Assigned
; output - STR = data in DATA, with trailing spaces removed
;
N K,D1,D2,D3,STR
S STR=""
I $G(DATA)="" Q "^^^"
S D1=$E(DATA,1,22),D2=$E(DATA,25,48),D3=$E(DATA,49,71)
F K=$L(D1):-1 Q:$E(D1,K)'=" " S D1=$E(D1,1,$L(D1)-1)
F K=$L(D2):-1 Q:$E(D2,K)'=" " S D2=$E(D2,1,$L(D2)-1)
F K=$L(D3):-1 Q:$E(D3,K)'=" " S D3=$E(D3,1,$L(D3)-1)
S STR=D1_U_D2_U_D3
Q STR
;
SSH ;Summary subheader
;Patch 589 changed "Practitioner" to "Clinician"
W !?72,"Patients",!,"Clinician",?24,"Position",?48,"Team"
W ?72,"Assigned",! N SCI F SCI=1:1:80 W "="
Q
HOLD(PAGE,TIT,MARG) ;
;device is home, reached end of page
N X
S MARG=$G(MARG) S:MARG'>80 MARG=80
W !!,"Press Any Key to Continue or '^' to Quit" R X:DTIME
I '$T!(X="^") S STOP=1 Q
W @IOF
Q
SHEAD ;
;Patch 589 - moved SHEAD from SCRPPAT3 and removed M.T. Stat
S @STORE@("H2")="Pt Name"
S $E(@STORE@("H2"),15)="Pt ID"
;Removed by patch 589
;S $E(@STORE@("H1"),25)="M.T."
;S $E(@STORE@("H2"),25)="Stat"
S $E(@STORE@("H1"),31)="Prim"
S $E(@STORE@("H2"),31)="Elig"
S $E(@STORE@("H1"),42)="Last"
S $E(@STORE@("H2"),42)="Appt"
S $E(@STORE@("H1"),54)="Next"
S $E(@STORE@("H2"),54)="Appt"
S $E(@STORE@("H2"),66)="Clinic"
S $P(@STORE@("H3"),"=",81)=""
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSCMCMHPP 10352 printed Nov 22, 2024@17:50:52 Page 2
SCMCMHPP ;BP-CIOFO/LLH - MH Clinician's Patients ; 2/7/2012 10:00am
+1 ;;5.3;Scheduling;**589**;AUG 13, 1993;Build 41
+2 ;
+3 ;Routine copied from SCRPPAT and modified for Mental Health.
+4 ;Specific modification is to screen for Mental Health teams and
+5 ;if all selected it will be all MH teams
+6 ;as well as outputting an '^' delimited summary report.
+7 ;
PROMPTS ;
+1 ;Prompt for division, team, role, clinician, summary only and
+2 ;print device
+3 ;
+4 NEW QTIME,PRNT,VAUTP,Y,VAUTD,VAUTT,VAUTR,VAUTS,SORT,NUMBER,VADEL
+5 KILL SCUP
+6 SET QTIME=""
+7 WRITE !
DO INST^SCRPU1
IF Y=-1
GOTO ERR
+8 ;Patch 589 - screen teams for Mental Health only
+9 WRITE !
KILL Y
DO PRMTT^SCMCMHU1
IF '$DATA(VAUTT)
GOTO ERR
+10 WRITE !
KILL Y
DO ROLE^SCRPU1
IF '$DATA(VAUTR)
GOTO ERR
+11 WRITE !
DO PRACT^SCMCMHU1
IF '$DATA(VAUTP)
GOTO ERR
+12 WRITE !
SET VAUTS=$$SUMM^SCRPU2()
IF VAUTS<0
GOTO ERR
+13 ;Patch 589 - if summary report being requested, ask for ^ delimited output
+14 if 'VAUTS
SET VADEL=0
+15 IF VAUTS
WRITE !
SET VADEL=$$DELOUT^SCMCMHU1()
IF VADEL<0
GOTO ERR
+16 SET SORT=""
+17 IF VADEL=1
SET SORT=1
+18 IF SORT'=1
WRITE !
SET SORT=$$SORT^SCMCMHU1()
IF SORT<1
GOTO ERR
+19 SET PRNT=$$PDEVICE^SCRPU3()
+20 IF PRNT=-1
GOTO ERR
+21 IF PRNT["Q;"
SET QTIME=$$GETTIME^SCRPU3()
+22 IF QTIME=-1
GOTO ERR
+23 IF PRNT'?1"Q;".E
SET PRNT="Q;"_PRNT
+24 ;Patch 589 - added VADEL
+25 SET NUMBER=$$ENTRY2(.VAUTD,.VAUTT,.VAUTR,.VAUTP,VAUTS,SORT,PRNT,QTIME,VADEL)
+26 IF NUMBER>0
WRITE !!,"Print queued, task number: ",NUMBER
+27 QUIT
+28 ;
ENTRY2(INST,TEAM,ROLE,PRACT,SUMM,SORT,IOP,ZTDTH,VADEL) ;
+1 ;Second entry point for GUI to use
+2 ;Input Parameters:
+3 ;INST - institutions selected (variable and array)
+4 ;TEAM - teams selected (variable and array)
+5 ;ROLE - roles selected (variable and array)
+6 ;PRACT - clinicians selected (ien new person file) - (variable and array)
+7 ;SUMM - summary info? y/n (1-yes/0-no) yes don't print patient data
+8 ;SORT - sort criteria (1-d,t,p/2-d,p,t)
+9 ;IOP - print device
+10 ;ZTDTH - queue time (optional)
+11 ;
+12 ;validate parameters
+13 IF '$DATA(INST)!'$DATA(TEAM)!'$DATA(ROLE)!'$DATA(PRACT)!'$DATA(SUMM)!'$DATA(SORT)!'$DATA(IOP)!(IOP="")!'$DATA(VADEL)
QUIT
+14 ;
+15 NEW NUMBER
+16 SET IOST=$PIECE(IOP,"^",2)
SET IOP=$PIECE(IOP,"^")
+17 IF IOP?1"Q;".E
SET IOP=$PIECE(IOP,"Q;",2)
+18 IF IOST?1"C-".E
DO QENTRY
GOTO RET
+19 IF ZTDTH=""
SET ZTDTH=$HOROLOG
+20 SET ZTRTN="QENTRY^SCMCMHPP"
+21 ;patch 589 changed clinician's to Clinician's
+22 SET ZTDESC="MH Clinician's Patients"
SET ZTIO=IOP
+23 NEW II
+24 ;Patch 589 added VADEL
+25 FOR II="IOSL","INST","INST(","TEAM","TEAM(","ROLE","ROLE(","PRACT(","PRACT","SUMM","IOP","SORT","VADEL"
SET ZTSAVE(II)=""
+26 DO ^%ZTLOAD
RET SET NUMBER=0
+1 IF $DATA(ZTSK)
SET NUMBER=ZTSK
+2 DO EXIT1
+3 QUIT NUMBER
+4 ;
QENTRY ;
+1 ;driver entry point
+2 ;patch 589 changed clinician's to Clinician's
+3 SET TITL="MH Clinician's Patients"
+4 IF SUMM
SET TITL=TITL_" Summary Report"
+5 SET STORE="^TMP("_$JOB_",""SCRPPAT"")"
+6 KILL @STORE
+7 SET @STORE=0
+8 ;Patch 589, changed from ^SCRPPAT2 to ^SCMCMHP2
+9 DO DRIVE^SCMCMHP2
+10 IF $ORDER(@STORE@(0))=""
SET NODATA=$$NODATA^SCRPU3(TITL)
+11 ;Patch 589 - if output is sent to a delimited format, use selected device
+12 ; but do special formating
+13 IF '$DATA(NODATA)&VADEL
DO SPECFMT(STORE)
+14 IF '$DATA(NODATA)&'VADEL
DO PRINTIT(STORE,IOP,TITL,SORT)
+15 DO EXIT2
+16 QUIT
+17 ;
ERR ;
EXIT1 ;
+1 KILL ZTDTH,ZTRTN,ZTDESC,ZTSK,ZTIO,ZTSAVE,VAUTD,VAUTT,VAUTP,VAUTR
+2 KILL SCUP,VAUTS,SORT
+3 QUIT
+4 ;
EXIT2 ;
+1 KILL @STORE
+2 KILL STORE,TITL,IOP,PRACT,INST,TEAM,ROLE,SORT,SUMM,NODATA,STOP
+3 QUIT
+4 ;
PRINTIT(STORE,IOP,TITL,SORT) ; Print All Data
+1 ;STORE - global location of data
+2 ;IOP - device to print to
+3 ;TITL - title of report
+4 ;SORT - sort order 1-div,team,clinician/2-div,clinician,team
+5 ;
+6 NEW PAGE
+7 SET PAGE=1
SET STOP=0
if $EXTRACT(IOST)="C"
WRITE @IOF
+8 NEW SEC1,SEC2,SEC2,SEC3,SEC4,ST1,ST2,ST3,ST4
+9 IF SORT=1
SET SEC1="""T"""
SET SEC2="""P"""
SET SEC3="""TN"""
SET SEC4="""PN"""
+10 IF SORT=2!(SORT=3)
SET SEC1="""P"""
SET SEC2="""T"""
SET SEC3="""PN"""
SET SEC4="""TN"""
+11 NEW SEC,TRD,INS,INAME,SECN,TRDN,PT,FIRST
+12 SET (INAME,INS)=""
SET FIRST=1
+13 FOR
SET INAME=$ORDER(@STORE@("I",INAME))
if INAME=""!(STOP)
QUIT
Begin DoDot:1
+14 SET INS=$ORDER(@STORE@("I",INAME,""))
+15 if INS=""!STOP
QUIT
+16 DO S
End DoDot:1
+17 DO S1
+18 QUIT
S ;
+1 SET SECN=""
SET ST1=$EXTRACT(STORE,1,($LENGTH(STORE)-1))_","_SEC1_")"
+2 FOR
SET SECN=$ORDER(@ST1@(INS,SECN))
if SECN=""!(STOP)
QUIT
Begin DoDot:1
+3 ;ien of team or clinician
SET SEC=$ORDER(@ST1@(INS,SECN,""))
+4 if SEC=""
QUIT
+5 SET ST3=$EXTRACT(STORE,1,($LENGTH(STORE)-1))_","_SEC3_")"
+6 SET TRDN=""
SET ST2=$EXTRACT(STORE,1,($LENGTH(STORE)-1))_","_SEC2_")"
+7 FOR
SET TRDN=$ORDER(@ST2@(INS,TRDN))
if TRDN=""!(STOP)
QUIT
Begin DoDot:2
+8 ;ien of team or clinician
SET TRD=$ORDER(@ST2@(INS,TRDN,""))
+9 if TRD=""
QUIT
+10 ;have first team and first clinician ien
+11 SET ST4=$EXTRACT(STORE,1,($LENGTH(STORE)-1))_","_SEC4_")"
+12 DO PRNT(ST4,ST3,SEC3,.PAGE,TITL,INS,SEC,TRD)
if STOP
QUIT
End DoDot:2
End DoDot:1
+13 QUIT
S1 IF $EXTRACT(IOST)="C"
IF 'STOP
WRITE !
NEW DIR
SET DIR(0)="E"
DO ^DIR
SET STOP=Y'=1
+1 IF 'STOP
IF SUMM=0
SET (FIRST,SUMM)=1
SET TITL=TITL_" Summary Report"
WRITE @IOF
DO PRINTIT(STORE,$GET(IOP),TITL,SORT)
+2 QUIT
+3 ;
PRNT(ST4,ST3,SEC3,PAGE,TITL,INS,SEC,TRD) ;
+1 ;
+2 NEW POS
+3 IF (SEC3="""PN""")&($DATA(@ST3@(INS,SEC,TRD)))
Begin DoDot:1
+4 ;get each position for clinician
+5 NEW MORE
SET POS=""
SET MORE=0
+6 FOR
SET POS=$ORDER(@ST3@(INS,SEC,TRD,POS))
if POS=""!(STOP)
QUIT
Begin DoDot:2
+7 IF 'SUMM
IF SORT=3
Begin DoDot:3
+8 ;I MORE ;S FIRST=0
+9 KILL @STORE@("H1")
DO SHEAD
+10 IF 'MORE
IF (PAGE=1)!(IOST?1"C-".E)
DO TITLE^SCRPU3(.PAGE,TITL)
+11 ;patch 589 -- modified to print, Clinician rather than Practitioner
+12 IF 'MORE
NEW STR
SET STR=$GET(@ST3@(INS,SEC,TRD,POS))
WRITE !," Clinician:"_$PIECE(STR,":",2),!
+13 ;I 'MORE W !,$G(@ST3@(INS,SEC,TRD,POS)),!
+14 DO PAT^SCRPPAT3(INS,SEC,TRD,SEC3,ST3,ST4,POS)
SET MORE=1
+15 IF $ORDER(@ST3@(INS,SEC,TRD,POS))=""
Begin DoDot:4
+16 IF (IOST?1"C-".E)
DO HOLD(.PAGE,"")
SET PAGE=PAGE+1
if STOP
QUIT
+17 IF (IOST'?1"C-".E)
DO NEWP1^SCRPU3(.PAGE,TITL)
if STOP
QUIT
End DoDot:4
End DoDot:3
QUIT
+18 IF SUMM
Begin DoDot:3
+19 IF FIRST
DO TITLE^SCRPU3(.PAGE,TITL)
DO SHEAD
DO SSH
SET FIRST=0
+20 IF (IOST'?1"C-".E)
IF $Y>(IOSL-4)
DO NEWP1^SCRPU3(.PAGE,TITL)
if STOP
QUIT
DO SSH
+21 IF (IOST?1"C-".E)
IF $Y>(IOSL-6)
DO HOLD^SCRPU3(.PAGE,TITL)
if STOP
QUIT
DO SSH
+22 WRITE !,@STORE@("SUM0",INS,SEC,TRD,POS)
+23 WRITE ?72,$JUSTIFY($GET(@STORE@("TOTAL",INS,SEC,TRD,POS)),8)
+24 QUIT
End DoDot:3
QUIT
+25 if SORT=3
QUIT
+26 IF FIRST
if 'MORE
DO TITLE^SCRPU3(.PAGE,TITL)
DO SHEAD
+27 ;patch 589 - commented W commands out, it wrote the division header incorrectly
+28 ;W:'STOP !,$G(@STORE@(INS))
IF (IOST'?1"C-".E)
IF 'SUMM
IF 'FIRST
DO NEWP1^SCRPU3(.PAGE,TITL)
+29 ;W:'STOP !,$G(@STORE@(INS))
IF (IOST?1"C-".E)
IF 'SUMM
IF 'FIRST
DO HOLD^SCRPU3(.PAGE,TITL)
+30 if STOP
QUIT
SET FIRST=1
IF 'MORE
SET FIRST=0
+31 ;patch 589 - modified to print, Clinician rather than Practitioner
+32 NEW STR
SET STR=$GET(@ST3@(INS,SEC,TRD,POS))
WRITE !," Clinician:"_$PIECE(STR,":",2)
+33 ;W !,$G(@ST3@(INS,SEC,TRD,POS)) ;write clinician (sort 1)
+34 IF $LENGTH($GET(@ST3@(INS,SEC,TRD,POS,"PRCP")))
WRITE !,@ST3@(INS,SEC,TRD,POS,"PRCP")
+35 ;write team (sort 2)
IF $GET(SORT)'=3
WRITE !,$GET(@ST4@(INS,TRD))
+36 WRITE !,$GET(@STORE@(INS))
+37 ;$o through patients for clinician on team
+38 DO PAT^SCRPPAT3(INS,SEC,TRD,SEC3,ST3,ST4,POS)
if STOP
QUIT
+39 IF (IOST'?1"C-".E)
IF $Y>(IOSL-4)
DO NEWP1^SCRPU3(.PAGE,TITL)
if STOP
QUIT
+40 IF (IOST?1"C-".E)
IF $Y>(IOSL-6)
DO HOLD^SCRPU3(.PAGE,TITL)
if STOP
QUIT
+41 ;print team/clinician total
DO TOTAL1^SCRPPAT3(INS,SEC,TRD,POS)
End DoDot:2
End DoDot:1
+42 ;
+43 IF (SEC3="""TN""")&($DATA(@ST4@(INS,TRD,SEC)))
Begin DoDot:1
+44 SET POS=""
+45 FOR
SET POS=$ORDER(@ST4@(INS,TRD,SEC,POS))
if POS=""!(STOP)
QUIT
Begin DoDot:2
+46 IF SUMM
Begin DoDot:3
+47 IF FIRST
DO TITLE^SCRPU3(.PAGE,TITL)
DO SHEAD
DO SSH
SET FIRST=0
+48 IF (IOST'?1"C-".E)
IF $Y>(IOSL-4)
DO NEWP1^SCRPU3(.PAGE,TITL)
if STOP
QUIT
DO SSH
+49 IF (IOST?1"C-".E)
IF $Y>(IOSL-6)
DO HOLD^SCRPU3(.PAGE,TITL)
if STOP
QUIT
DO SSH
+50 WRITE !,@STORE@("SUM0",INS,TRD,SEC,POS)
+51 WRITE ?72,$JUSTIFY(@STORE@("TOTAL",INS,TRD,SEC,POS),8)
+52 QUIT
End DoDot:3
QUIT
+53 IF FIRST
DO TITLE^SCRPU3(.PAGE,TITL)
DO SHEAD
+54 IF (IOST'?1"C-".E)
IF 'SUMM
IF 'FIRST
DO NEWP1^SCRPU3(.PAGE,TITL)
+55 IF (IOST?1"C-".E)
IF 'SUMM
IF 'FIRST
DO HOLD^SCRPU3(.PAGE,TITL)
+56 if STOP
QUIT
SET FIRST=0
+57 ;write team (sort 1)
IF $GET(SORT)'=3
WRITE !,$GET(@ST3@(INS,SEC))
+58 WRITE !,$GET(@STORE@(INS))
+59 ;patch 589 - modified to print, Clinician rather than Practitioner
+60 IF $GET(SORT)'=3
NEW STR
Begin DoDot:3
+61 SET STR=$GET(@ST4@(INS,TRD,SEC,POS))
WRITE !," Clinician:"_$PIECE(STR,":",2)
End DoDot:3
+62 ;I $G(SORT)'=3 W !,$G(@ST4@(INS,TRD,SEC,POS)) ;write clinician (sort 2)
+63 IF $LENGTH($GET(@ST4@(INS,TRD,SEC,POS,"PRCP")))
WRITE !,@ST4@(INS,TRD,SEC,POS,"PRCP")
+64 WRITE !
+65 ;$o through patients for clinician on team
+66 DO PAT^SCRPPAT3(INS,SEC,TRD,SEC3,ST3,ST4,POS)
if STOP
QUIT
+67 IF (IOST'?1"C-".E)
IF $Y>(IOSL-4)
DO NEWP1^SCRPU3(.PAGE,TITL)
if STOP
QUIT
+68 IF (IOST?1"C-".E)
IF $Y>(IOSL-6)
DO HOLD^SCRPU3(.PAGE,TITL)
if STOP
QUIT
+69 ;print team/clinician total
DO TOTAL1^SCRPPAT3(INS,SEC,TRD,POS)
End DoDot:2
End DoDot:1
+70 QUIT
+71 ;
SPECFMT(STORE) ; Patch 589 - format delimited output
+1 ;STORE - global location of data
+2 ;IOP - device to print to
+3 ;TITL - title of report
+4 ;SORT - sort order 1-div,team,clinician/2-div,clinician,team
+5 ;
+6 NEW DATA,INS,POS,SEC,TRD
+7 ;Patch 589 changed Practitioner's to Clinician
+8 WRITE !,"Printed on: "_$$FMTE^XLFDT(DT,"5D")_U_"Clinician's Patients Summary Report"
+9 WRITE !,"Clinician"_U_"Position"_U_"Team"_U_"Patients Assigned"
+10 SET INS=0
FOR
SET INS=$ORDER(@STORE@("SUM0",INS))
if INS'>0
QUIT
Begin DoDot:1
+11 SET SEC=0
FOR
SET SEC=$ORDER(@STORE@("SUM0",INS,SEC))
if SEC'>0
QUIT
Begin DoDot:2
+12 SET TRD=0
FOR
SET TRD=$ORDER(@STORE@("SUM0",INS,SEC,TRD))
if TRD'>0
QUIT
Begin DoDot:3
+13 SET POS=0
FOR
SET POS=$ORDER(@STORE@("SUM0",INS,SEC,TRD,POS))
if POS'>0
QUIT
Begin DoDot:4
+14 SET DATA=@STORE@("SUM0",INS,SEC,TRD,POS)
+15 WRITE !,$$FMTDATA(DATA)_U_$GET(@STORE@("TOTAL",INS,SEC,TRD,POS))
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+16 QUIT
+17 ;
FMTDATA(DATA) ;
+1 ; patch 589, used to strip trailing spaces from the formated data
+2 ; input - DATA = formatted data, clinician, Position, Team and Patients Assigned
+3 ; output - STR = data in DATA, with trailing spaces removed
+4 ;
+5 NEW K,D1,D2,D3,STR
+6 SET STR=""
+7 IF $GET(DATA)=""
QUIT "^^^"
+8 SET D1=$EXTRACT(DATA,1,22)
SET D2=$EXTRACT(DATA,25,48)
SET D3=$EXTRACT(DATA,49,71)
+9 FOR K=$LENGTH(D1):-1
if $EXTRACT(D1,K)'=" "
QUIT
SET D1=$EXTRACT(D1,1,$LENGTH(D1)-1)
+10 FOR K=$LENGTH(D2):-1
if $EXTRACT(D2,K)'=" "
QUIT
SET D2=$EXTRACT(D2,1,$LENGTH(D2)-1)
+11 FOR K=$LENGTH(D3):-1
if $EXTRACT(D3,K)'=" "
QUIT
SET D3=$EXTRACT(D3,1,$LENGTH(D3)-1)
+12 SET STR=D1_U_D2_U_D3
+13 QUIT STR
+14 ;
SSH ;Summary subheader
+1 ;Patch 589 changed "Practitioner" to "Clinician"
+2 WRITE !?72,"Patients",!,"Clinician",?24,"Position",?48,"Team"
+3 WRITE ?72,"Assigned",!
NEW SCI
FOR SCI=1:1:80
WRITE "="
+4 QUIT
HOLD(PAGE,TIT,MARG) ;
+1 ;device is home, reached end of page
+2 NEW X
+3 SET MARG=$GET(MARG)
if MARG'>80
SET MARG=80
+4 WRITE !!,"Press Any Key to Continue or '^' to Quit"
READ X:DTIME
+5 IF '$TEST!(X="^")
SET STOP=1
QUIT
+6 WRITE @IOF
+7 QUIT
SHEAD ;
+1 ;Patch 589 - moved SHEAD from SCRPPAT3 and removed M.T. Stat
+2 SET @STORE@("H2")="Pt Name"
+3 SET $EXTRACT(@STORE@("H2"),15)="Pt ID"
+4 ;Removed by patch 589
+5 ;S $E(@STORE@("H1"),25)="M.T."
+6 ;S $E(@STORE@("H2"),25)="Stat"
+7 SET $EXTRACT(@STORE@("H1"),31)="Prim"
+8 SET $EXTRACT(@STORE@("H2"),31)="Elig"
+9 SET $EXTRACT(@STORE@("H1"),42)="Last"
+10 SET $EXTRACT(@STORE@("H2"),42)="Appt"
+11 SET $EXTRACT(@STORE@("H1"),54)="Next"
+12 SET $EXTRACT(@STORE@("H2"),54)="Appt"
+13 SET $EXTRACT(@STORE@("H2"),66)="Clinic"
+14 SET $PIECE(@STORE@("H3"),"=",81)=""
+15 QUIT
