164 lines
5.3 KiB
Mathematica
164 lines
5.3 KiB
Mathematica
SCRPTM ;ALB/CMM - List of Team's Members Report ; 29 Jun 99 04:11PM
|
|
;;5.3;Scheduling;**41,48,52,181,177**;AUG 13, 1993
|
|
;
|
|
;List of Team's Members Report
|
|
;
|
|
PROMPTS ;
|
|
;Prompt for Institution, Team, Date Range, User Class, Role
|
|
;and Print device
|
|
;
|
|
N VAUTD,VAUTT,VAUTUC,VAUTR,QTIME,RANG,PRNT,NUMBER
|
|
K VAUTD,VAUTT,VAUTUC,VAUTR,SCUP
|
|
S QTIME=""
|
|
W ! D INST^SCRPU1 I Y=-1 G ERR
|
|
W ! K Y D PRMTT^SCRPU1 I '$D(VAUTT) G ERR
|
|
W ! K Y S RANG=$$DTRANG^SCRPU2() I +RANG=-1 G ERR
|
|
W ! K Y D USER^SCRPU1 I '$D(VAUTUC)&($P($G(^SD(404.91,1,"PCMM")),"^")=1) G ERR
|
|
W ! K Y D ROLE^SCRPU1 I '$D(VAUTR) G ERR
|
|
D QUE(.VAUTD,.VAUTT,.VAUTUC,.VAUTR,RANG) Q
|
|
;
|
|
QUE(INST,TEAM,USERC,ROLE,RANGE) ;queue report
|
|
;Input Parameters:
|
|
;INST - institutions selected (variable and array)
|
|
;TEAM - teams selected (variable and array)
|
|
;USERC - user classes selected (variable and array)
|
|
;ROLE - roles selected (variable and array)
|
|
;RANGE - date range selected (begin date ^ end date)
|
|
N ZTSAVE,II
|
|
F II="INST","TEAM","USERC","ROLE","INST(","TEAM(","USERC(","ROLE(","RANGE" S ZTSAVE(II)=""
|
|
W ! D EN^XUTMDEVQ("QENTRY^SCRPTM","Team Member Listing",.ZTSAVE)
|
|
Q
|
|
;
|
|
ENTRY2(INST,TEAM,USERC,ROLE,RANGE,IOP,ZTDTH) ;
|
|
;Second entry point for GUI to use
|
|
;Input Parameters:
|
|
;INST - institutions selected (variable and array)
|
|
;TEAM - teams selected (variable and array)
|
|
;USERC - user classes selected (variable and array)
|
|
;ROLE - roles selected (variable and array)
|
|
;RANGE - date range selected (begin date ^ end date)
|
|
;IOP - print device
|
|
;ZTDTH - queue time (optional)
|
|
;
|
|
;validate parameters
|
|
I '$D(INST)!'$D(TEAM)!'$D(ROLE)!'$D(RANGE)!'$D(IOP)!(IOP="") 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^SCRPTM"
|
|
S ZTDESC="List of Team's Members",ZTIO=IOP
|
|
N II
|
|
F II="INST","TEAM","USERC","ROLE","INST(","TEAM(","USERC(","ROLE(","RANGE","IOP" S ZTSAVE(II)=""
|
|
D ^%ZTLOAD
|
|
RET S NUMBER=0
|
|
I $D(ZTSK) S NUMBER=ZTSK
|
|
D EXIT1
|
|
Q NUMBER
|
|
;
|
|
QENTRY ;
|
|
;driver entry point
|
|
S TITL="Team Member Listing"
|
|
S STORE="^TMP("_$J_",""SCRPTM"")"
|
|
K @STORE
|
|
S @STORE=0
|
|
D BUILD
|
|
I $O(@STORE@(0))="" S NODATA=$$NODATA^SCRPU3(TITL)
|
|
I '$D(NODATA) D PRINTIT(STORE,TITL)
|
|
D EXIT2
|
|
Q
|
|
;
|
|
ERR ;
|
|
EXIT1 ;
|
|
K ZTDTH,ZTRTN,ZTDESC,ZTSK,ZTIO,ZTSAVE,SCUP
|
|
Q
|
|
EXIT2 ;
|
|
K @STORE
|
|
K STOP,STORE,TITL,IOP,TEAM,INST,NODATA,RANGE,ROLE,USERC
|
|
Q
|
|
;
|
|
BUILD ;get report data
|
|
;get all practitioners for all teams selected
|
|
I TEAM=1 D TALL ;all teams selected
|
|
N TIEN,OKAY,XLIST,YLIST,SCTP,SCI,SCDT,PLIST
|
|
S SCDT("BEGIN")=$P(RANGE,U),SCDT("END")=$P(RANGE,U,2)
|
|
S SCDT("INCL")=0,SCDT="SCDT"
|
|
S TIEN="",PLIST="^TMP(""SCRP"",$J,""LIST"")"
|
|
F S TIEN=$O(TEAM(TIEN)) Q:TIEN=""!(TIEN'?.N) D
|
|
.K XLIST,@PLIST
|
|
.S OKAY=$$TPTM^SCAPMC(TIEN,.SCDT,"","","XLIST","ERROR")
|
|
.S SCTP=0 F S SCTP=$O(XLIST("SCTP",TIEN,SCTP)) Q:'SCTP D
|
|
..S SCTP0=$G(^SCTM(404.57,SCTP,0)) Q:'$L(SCTP0)
|
|
..I ROLE'=1,'$D(ROLE(+$P(SCTP0,U,3))) Q ;not a selected role
|
|
..I $D(USERC),USERC'=1,'$D(USERC(+$P(SCTP0,U,13))) Q ;not a selected user class
|
|
..K YLIST
|
|
..S OKAY=$$PRTP^SCAPMC(SCTP,.SCDT,"YLIST","ERROR",1,0)
|
|
..S SCI=0 F S SCI=$O(YLIST(SCI)) Q:'SCI D
|
|
...S @PLIST@(0)=$G(@PLIST@(0))+1
|
|
...S @PLIST@(@PLIST@(0))=YLIST(SCI)
|
|
...Q
|
|
..Q
|
|
.I OKAY D PULL^SCRPTM2(TIEN,.PLIST)
|
|
.Q
|
|
Q
|
|
;
|
|
TALL ;
|
|
;get all active team for divisions selected
|
|
N NXT,IIEN,NODE
|
|
S NXT=0,IIEN=""
|
|
;$O through team file and find all active teams for selected divisions
|
|
F S IIEN=$O(^SCTM(404.51,"AINST",IIEN)) Q:IIEN="" D
|
|
.I INST=1!$D(INST(IIEN)) D
|
|
..S TIEN=0
|
|
..F S TIEN=$O(^SCTM(404.51,"AINST",IIEN,TIEN)) Q:TIEN="" D
|
|
...I $$ACTTM^SCMCTMU(TIEN) S TEAM(TIEN)=""
|
|
Q
|
|
;
|
|
PRINTIT(STORE,TITL) ;
|
|
N INST,EINST,ETEAM,TEM,EPRACT,PRACT,PAGE,NXT,NPAGE,CNT,HEAD,POS
|
|
S EINST="",(NPAGE,STOP,HEAD)=0,PAGE=1 W:$E(IOST)="C" @IOF
|
|
D TITLE^SCRPU3(.PAGE,TITL)
|
|
F S EINST=$O(@STORE@("I",EINST)) Q:EINST=""!(STOP) D
|
|
.S INST=$O(@STORE@("I",EINST,""))
|
|
.Q:INST=""
|
|
.I 'NPAGE W !,$G(@STORE@(INST)) ;write institution line
|
|
.S (ETEAM,TEM)=""
|
|
.F S ETEAM=$O(@STORE@("T",INST,ETEAM)) Q:ETEAM=""!(STOP) D
|
|
..S TEM=$O(@STORE@("T",INST,ETEAM,0))
|
|
..I TEM="" Q
|
|
..S NXT="H"
|
|
..I NPAGE,(IOST'?1"C-".E) D NEWP^SCRPTM2(INST,TEM,TITL,.PAGE,.HEAD) S NPAGE=0
|
|
..I NPAGE,(IOST?1"C-".E) D HOLD1^SCRPTM2(.PAGE,TITL,INST,TEM,.HEAD) S NPAGE=0
|
|
..I STOP Q
|
|
..I IOST'?1"C-".E,$Y>(IOSL-5) D NEWP^SCRPTM2(INST,TEM,TITL,.PAGE,.HEAD)
|
|
..I IOST?1"C-".E,$Y>(IOSL-5) D HOLD1^SCRPTM2(.PAGE,TITL,INST,TEM,.HEAD)
|
|
..I STOP Q
|
|
..F S NXT=$O(@STORE@(INST,TEM,NXT)) Q:NXT'?1"H".E!(STOP) D
|
|
...I 'HEAD W !,$G(@STORE@(INST,TEM,NXT)) S HEAD=0 ;writes team info
|
|
..S (EPRACT,PRACT)=""
|
|
..W ! ;extra line between members and practioner list
|
|
..F S EPRACT=$O(@STORE@("PN",INST,TEM,EPRACT)) Q:EPRACT=""!(STOP) D
|
|
...F S PRACT=$O(@STORE@("PN",INST,TEM,EPRACT,PRACT)) Q:PRACT=""!(STOP) D
|
|
....I PRACT="" Q
|
|
....S POS=""
|
|
....F S POS=$O(@STORE@("PN",INST,TEM,EPRACT,PRACT,POS)) Q:POS=""!(STOP) D
|
|
.....D PRNTD(INST,TEM,PRACT,POS,TITL,.PAGE,.HEAD)
|
|
.....W ! ;seperated positions
|
|
....W ! ;separates practitioners
|
|
.S NPAGE=1
|
|
I 'STOP,$E(IOST)="C" N DIR S DIR(0)="E" W ! D ^DIR
|
|
Q
|
|
;
|
|
PRNTD(INST,TEM,PRACT,POS,TITL,PAGE,HEAD) ;
|
|
;
|
|
N CNT
|
|
S CNT=""
|
|
I IOST'?1"C-".E,$Y>(IOSL-11) D NEWP^SCRPTM2(INST,TEM,TITL,.PAGE,.HEAD)
|
|
I IOST?1"C-".E,$Y>(IOSL-11) D HOLD1^SCRPTM2(.PAGE,TITL,INST,TEM,.HEAD)
|
|
I STOP Q
|
|
F S CNT=$O(@STORE@(INST,TEM,PRACT,POS,CNT)) Q:CNT=""!(STOP) D
|
|
.W !,$G(@STORE@(INST,TEM,PRACT,POS,CNT))
|
|
Q
|