source: FOIAVistA/tag/r/SCHEDULING-SD-SC/SCRPSLT.m@ 629

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