Index: WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SCRPSLT.m
===================================================================
--- WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SCRPSLT.m	(revision 613)
+++ WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SCRPSLT.m	(revision 623)
@@ -1,147 +1,143 @@
-SCRPSLT	;ALB/CMM - Summary Listing of Teams ; 29 Jun 99  04:11PM
-	;;5.3;Scheduling;**41,52,177,231,520**;AUG 13, 1993;Build 26
-	;
-	;Summary Listing of Teams Report
-	;
-PROMPTS	;
-	;Prompt for Institution, Team, Role and Print device
-	;
-	N VAUTD,VAUTT,VAUTR,QTIME,PRNT,NUMBER
-	K VAUTD,VAUTT,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 D ROLE^SCRPU1 I '$D(VAUTR) G ERR
-	W !!,"This report requires 132 column output!"
-	D QUE(.VAUTD,.VAUTT,.VAUTR) Q
-	;
-QUE(INST,TEAM,ROLE)	;queue report
-	;Input Parameters: 
-	;INST - institutions selected (variable and array) 
-	;TEAM - teams selected (variable and array) 
-	;ROLE - roles selected (variable and array)
-	N ZTSAVE,II
-	F II="INST","TEAM","ROLE","INST(","TEAM(","ROLE(" S ZTSAVE(II)=""
-	W ! D EN^XUTMDEVQ("QENTRY^SCRPSLT","Summary Listing of Teams",.ZTSAVE)
-	Q
-	;
-ENTRY2(INST,TEAM,ROLE,IOP,ZTDTH)	;
-	;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)
-	;IOP - print device
-	;ZTDTH - queue time (optional)
-	;
-	;validate parameters
-	I '$D(INST)!'$D(TEAM)!'$D(ROLE)!'$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^SCRPSLT"
-	S ZTDESC="Summary Listing Of Teams",ZTIO=IOP
-	N II
-	F II="INST","TEAM","ROLE","INST(","TEAM(","ROLE(","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="Summary Listing of Teams"
-	S STORE="^TMP("_$J_",""SCRPSLT"")"
-	K @STORE
-	S @STORE=0
-	I TEAM=1 D TALL^SCRPPAT3 S TEAM=0
-	D FIND
-	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,ROLE,NODATA
-	Q
-	;
-FIND	;
-	N TM,EN2,EN,ROL,NODE,TEND,ACT,INA,TPASS,TPCN,TMAX,TMP,TOA,TNPC
-	S TM=""
-	F  S TM=$O(^SCTM(404.57,"C",TM)) Q:TM=""  D
-	.;$O through team position file
-	.I '$D(TEAM(TM))&(TEAM'=1) Q
-	.;Q above, not a selected team
-	.;selected team
-	.S EN=""
-	.S TPASS(TM)=0,TMAX(TM)=0,TPCN(TM)=0
-	.F  S EN=$O(^SCTM(404.57,"C",TM,EN)) Q:EN=""  D
-	..I '$D(^SCTM(404.57,EN,0)) Q
-	..S NODE=$G(^SCTM(404.57,EN,0))
-	..Q:NODE=""
-	..S ROL=+$P(NODE,"^",3) ;role ien
-	..I '$D(ROLE(ROL))&(ROLE'=1) Q
-	..;Q above not a selected role
-	..;find active position during date range
-	..S TMP=$$DATES^SCAPMCU1(404.52,EN,DT)
-	..I +TMP=0 Q
-	..S EN2=+$P(TMP,"^",4)
-	..D KEEP^SCRPSLT2(NODE,EN,EN2,ROL,TM,.TPCN,.TNPC)
-	..S TPASS(TM)=$$TEAMCNT^SCAPMCU1(TM,DT)
-	..S TMAX(TM)=+$P($G(^SCTM(404.51,+TM,0)),U,8)
-	..S TOA(TM)=TMAX(TM)-TPASS(TM) S:TOA(TM)<0 TOA(TM)=0
-	..D TEAMT^SCRPSLT2(TM,.TPASS,.TMAX,.TPCN,.TOA,.TNPC)
-	Q
-	;
-PRINTIT(STORE,TITL)	;
-	N INST,EINST,ETEAM,TEM,EPRACT,PRACT,NXT,PAGE,NPAGE,NEW,POS,SCAC
-	S (INST,EINST)="",(NPAGE,STOP)=0,PAGE=1 W:$E(IOST)="C" @IOF
-	D TITLE^SCRPU3(.PAGE,TITL)
-	D FORHEAD^SCRPSLT2
-	F  S EINST=$O(@STORE@("I",EINST)) Q:EINST=""!(STOP)  D
-	.S INST=$O(@STORE@("I",EINST,""))
-	.I INST="" Q
-	.S (TEM,ETEAM)=""
-	.F  S ETEAM=$O(@STORE@("T",INST,ETEAM)) Q:ETEAM=""!(STOP)  D
-	..S TEM=$O(@STORE@("T",INST,ETEAM,""))
-	..I TEM="" Q
-	..K NEW
-	..I NPAGE,(IOST'?1"C-".E) D NEWP^SCRPSLT2(INST,TEM,TITL,.PAGE) S NEW=""
-	..I NPAGE,(IOST?1"C-".E) D HOLD1^SCRPSLT2(.PAGE,TITL,INST,TEM) S NEW=""
-	..S NPAGE=1 I STOP Q
-	..I IOST'?1"C-".E,$Y>(IOSL-8) D NEWP^SCRPSLT2(INST,TEM,TITL,.PAGE) S NEW=""
-	..I IOST?1"C-".E,$Y>(IOSL-8) D HOLD1^SCRPSLT2(.PAGE,TITL,INST,TEM) S NEW=""
-	..I STOP Q
-	..I '$D(NEW) D HEADER^SCRPSLT2(INST,TEM)
-	..S (PRACT,EPRACT)=""
-	..F  S EPRACT=$O(@STORE@("PN",INST,TEM,EPRACT)) Q:EPRACT=""!(STOP)  D
-	...S PRACT=$O(@STORE@("PN",INST,TEM,EPRACT,""))
-	...I PRACT="" Q
-	...S POS=""
-	...F  S POS=$O(@STORE@(INST,TEM,PRACT,POS)) Q:POS=""!(STOP)  D
-	....W !,$G(@STORE@(INST,TEM,PRACT,POS))
-	....S SCAC=""
-	....F  S SCAC=$O(@STORE@(INST,TEM,PRACT,POS,SCAC)) Q:SCAC=""!(STOP)  D
-	.....W !,$G(@STORE@(INST,TEM,PRACT,POS,SCAC))
-	.....I IOST'?1"C-".E,$Y>(IOSL-4) D NEWP^SCRPSLT2(INST,TEM,TITL,.PAGE)
-	.....I IOST?1"C-".E,$Y>(IOSL-4) D HOLD1^SCRPSLT2(.PAGE,TITL,INST,TEM)
-	.....I STOP Q
-	....;W !,$G(@STORE@(INST,TEM,PRACT,POS)) ;writes info
-	..Q:STOP
-	..I IOST'?1"C-".E,$Y>(IOSL-8) D NEWP^SCRPSLT2(INST,TEM,TITL,.PAGE,1)
-	..I IOST?1"C-".E,$Y>(IOSL-8) D HOLD1^SCRPSLT2(.PAGE,TITL,INST,TEM,1)
-	..D TOTAL^SCRPSLT2(INST,TEM)
-	.I STOP Q
-	.S NPAGE=1
-	I 'STOP,$E(IOST)="C" N DIR S DIR(0)="E" D ^DIR
-	Q
+SCRPSLT ;ALB/CMM - Summary Listing of Teams ; 29 Jun 99  04:11PM
+ ;;5.3;Scheduling;**41,52,177,231**;AUG 13, 1993
+ ;
+ ;Summary Listing of Teams Report
+ ;
+PROMPTS ;
+ ;Prompt for Institution, Team, Role and Print device
+ ;
+ N VAUTD,VAUTT,VAUTR,QTIME,PRNT,NUMBER
+ K VAUTD,VAUTT,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 D ROLE^SCRPU1 I '$D(VAUTR) G ERR
+ W !!,"This report requires 132 column output!"
+ D QUE(.VAUTD,.VAUTT,.VAUTR) Q
+ ;
+QUE(INST,TEAM,ROLE) ;queue report
+ ;Input Parameters: 
+ ;INST - institutions selected (variable and array) 
+ ;TEAM - teams selected (variable and array) 
+ ;ROLE - roles selected (variable and array)
+ N ZTSAVE,II
+ F II="INST","TEAM","ROLE","INST(","TEAM(","ROLE(" S ZTSAVE(II)=""
+ W ! D EN^XUTMDEVQ("QENTRY^SCRPSLT","Summary Listing of Teams",.ZTSAVE)
+ Q
+ ;
+ENTRY2(INST,TEAM,ROLE,IOP,ZTDTH) ;
+ ;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)
+ ;IOP - print device
+ ;ZTDTH - queue time (optional)
+ ;
+ ;validate parameters
+ I '$D(INST)!'$D(TEAM)!'$D(ROLE)!'$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^SCRPSLT"
+ S ZTDESC="Summary Listing Of Teams",ZTIO=IOP
+ N II
+ F II="INST","TEAM","ROLE","INST(","TEAM(","ROLE(","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="Summary Listing of Teams"
+ S STORE="^TMP("_$J_",""SCRPSLT"")"
+ K @STORE
+ S @STORE=0
+ I TEAM=1 D TALL^SCRPPAT3 S TEAM=0
+ D FIND
+ 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,ROLE,NODATA
+ Q
+ ;
+FIND ;
+ N TM,EN2,EN,ROL,NODE,TEND,ACT,INA,TPASS,TPCN,TMAX,TMP,TOA,TNPC
+ S TM=""
+ F  S TM=$O(^SCTM(404.57,"C",TM)) Q:TM=""  D
+ .;$O through team position file
+ .I '$D(TEAM(TM))&(TEAM'=1) Q
+ .;Q above, not a selected team
+ .;selected team
+ .S EN=""
+ .S TPASS(TM)=0,TMAX(TM)=0,TPCN(TM)=0
+ .F  S EN=$O(^SCTM(404.57,"C",TM,EN)) Q:EN=""  D
+ ..I '$D(^SCTM(404.57,EN,0)) Q
+ ..S NODE=$G(^SCTM(404.57,EN,0))
+ ..Q:NODE=""
+ ..S ROL=+$P(NODE,"^",3) ;role ien
+ ..I '$D(ROLE(ROL))&(ROLE'=1) Q
+ ..;Q above not a selected role
+ ..;find active position during date range
+ ..S TMP=$$DATES^SCAPMCU1(404.52,EN,DT)
+ ..I +TMP=0 Q
+ ..S EN2=+$P(TMP,"^",4)
+ ..D KEEP^SCRPSLT2(NODE,EN,EN2,ROL,TM,.TPCN,.TNPC)
+ ..S TPASS(TM)=$$TEAMCNT^SCAPMCU1(TM,DT)
+ ..S TMAX(TM)=+$P($G(^SCTM(404.51,+TM,0)),U,8)
+ ..S TOA(TM)=TMAX(TM)-TPASS(TM) S:TOA(TM)<0 TOA(TM)=0
+ ..D TEAMT^SCRPSLT2(TM,.TPASS,.TMAX,.TPCN,.TOA,.TNPC)
+ Q
+ ;
+PRINTIT(STORE,TITL) ;
+ N INST,EINST,ETEAM,TEM,EPRACT,PRACT,NXT,PAGE,NPAGE,NEW,POS
+ S (INST,EINST)="",(NPAGE,STOP)=0,PAGE=1 W:$E(IOST)="C" @IOF
+ D TITLE^SCRPU3(.PAGE,TITL)
+ D FORHEAD^SCRPSLT2
+ F  S EINST=$O(@STORE@("I",EINST)) Q:EINST=""!(STOP)  D
+ .S INST=$O(@STORE@("I",EINST,""))
+ .I INST="" Q
+ .S (TEM,ETEAM)=""
+ .F  S ETEAM=$O(@STORE@("T",INST,ETEAM)) Q:ETEAM=""!(STOP)  D
+ ..S TEM=$O(@STORE@("T",INST,ETEAM,""))
+ ..I TEM="" Q
+ ..K NEW
+ ..I NPAGE,(IOST'?1"C-".E) D NEWP^SCRPSLT2(INST,TEM,TITL,.PAGE) S NEW=""
+ ..I NPAGE,(IOST?1"C-".E) D HOLD1^SCRPSLT2(.PAGE,TITL,INST,TEM) S NEW=""
+ ..S NPAGE=1 I STOP Q
+ ..I IOST'?1"C-".E,$Y>(IOSL-8) D NEWP^SCRPSLT2(INST,TEM,TITL,.PAGE) S NEW=""
+ ..I IOST?1"C-".E,$Y>(IOSL-8) D HOLD1^SCRPSLT2(.PAGE,TITL,INST,TEM) S NEW=""
+ ..I STOP Q
+ ..I '$D(NEW) D HEADER^SCRPSLT2(INST,TEM)
+ ..S (PRACT,EPRACT)=""
+ ..F  S EPRACT=$O(@STORE@("PN",INST,TEM,EPRACT)) Q:EPRACT=""!(STOP)  D
+ ...S PRACT=$O(@STORE@("PN",INST,TEM,EPRACT,""))
+ ...I PRACT="" Q
+ ...S POS=""
+ ...F  S POS=$O(@STORE@(INST,TEM,PRACT,POS)) Q:POS=""!(STOP)  D
+ ....I IOST'?1"C-".E,$Y>(IOSL-4) D NEWP^SCRPSLT2(INST,TEM,TITL,.PAGE)
+ ....I IOST?1"C-".E,$Y>(IOSL-4) D HOLD1^SCRPSLT2(.PAGE,TITL,INST,TEM)
+ ....I STOP Q
+ ....W !,$G(@STORE@(INST,TEM,PRACT,POS)) ;writes info
+ ..Q:STOP
+ ..I IOST'?1"C-".E,$Y>(IOSL-8) D NEWP^SCRPSLT2(INST,TEM,TITL,.PAGE,1)
+ ..I IOST?1"C-".E,$Y>(IOSL-8) D HOLD1^SCRPSLT2(.PAGE,TITL,INST,TEM,1)
+ ..D TOTAL^SCRPSLT2(INST,TEM)
+ .I STOP Q
+ .S NPAGE=1
+ I 'STOP,$E(IOST)="C" N DIR S DIR(0)="E" D ^DIR
+ Q
