Changeset 623 for WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SCRPSLT.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
-
WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SCRPSLT.m (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SCRPSLT.m
r613 r623 1 SCRPSLT ;ALB/CMM - Summary Listing of Teams ; 29 Jun 99 04:11PM 2 ;;5.3;Scheduling;**41,52,177,231,520**;AUG 13, 1993;Build 26 3 ; 4 ;Summary Listing of Teams Report 5 ; 6 PROMPTS ; 7 ;Prompt for Institution, Team, Role and Print device 8 ; 9 N VAUTD,VAUTT,VAUTR,QTIME,PRNT,NUMBER 10 K VAUTD,VAUTT,VAUTR,SCUP 11 S QTIME="" 12 W ! D INST^SCRPU1 I Y=-1 G ERR 13 W ! K Y D PRMTT^SCRPU1 I '$D(VAUTT) G ERR 14 W ! K Y D ROLE^SCRPU1 I '$D(VAUTR) G ERR 15 W !!,"This report requires 132 column output!" 16 D QUE(.VAUTD,.VAUTT,.VAUTR) Q 17 ; 18 QUE(INST,TEAM,ROLE) ;queue report 19 ;Input Parameters: 20 ;INST - institutions selected (variable and array) 21 ;TEAM - teams selected (variable and array) 22 ;ROLE - roles selected (variable and array) 23 N ZTSAVE,II 24 F II="INST","TEAM","ROLE","INST(","TEAM(","ROLE(" S ZTSAVE(II)="" 25 W ! D EN^XUTMDEVQ("QENTRY^SCRPSLT","Summary Listing of Teams",.ZTSAVE) 26 Q 27 ; 28 ENTRY2(INST,TEAM,ROLE,IOP,ZTDTH) ; 29 ;Second entry point for GUI to use 30 ;Input Parameters: 31 ;INST - institutions selected (variable and array) 32 ;TEAM - teams selected (variable and array) 33 ;ROLE - roles selected (variable and array) 34 ;IOP - print device 35 ;ZTDTH - queue time (optional) 36 ; 37 ;validate parameters 38 I '$D(INST)!'$D(TEAM)!'$D(ROLE)!'$D(IOP)!(IOP="") Q 39 ; 40 N NUMBER 41 S IOST=$P(IOP,"^",2),IOP=$P(IOP,"^") 42 I IOP?1"Q;".E S IOP=$P(IOP,"Q;",2) 43 I IOST?1"C-".E D QENTRY G RET 44 I ZTDTH="" S ZTDTH=$H 45 S ZTRTN="QENTRY^SCRPSLT" 46 S ZTDESC="Summary Listing Of Teams",ZTIO=IOP 47 N II 48 F II="INST","TEAM","ROLE","INST(","TEAM(","ROLE(","IOP" S ZTSAVE(II)="" 49 D ^%ZTLOAD 50 RET S NUMBER=0 51 I $D(ZTSK) S NUMBER=ZTSK 52 D EXIT1 53 Q NUMBER 54 ; 55 QENTRY ; 56 ;driver entry point 57 S TITL="Summary Listing of Teams" 58 S STORE="^TMP("_$J_",""SCRPSLT"")" 59 K @STORE 60 S @STORE=0 61 I TEAM=1 D TALL^SCRPPAT3 S TEAM=0 62 D FIND 63 I $O(@STORE@(0))="" S NODATA=$$NODATA^SCRPU3(TITL) 64 I '$D(NODATA) D PRINTIT(STORE,TITL) 65 D EXIT2 66 Q 67 ; 68 ERR ; 69 EXIT1 ; 70 K ZTDTH,ZTRTN,ZTDESC,ZTSK,ZTIO,ZTSAVE,SCUP 71 Q 72 ; 73 EXIT2 ; 74 K @STORE 75 K STOP,STORE,TITL,IOP,TEAM,INST,ROLE,NODATA 76 Q 77 ; 78 FIND ; 79 N TM,EN2,EN,ROL,NODE,TEND,ACT,INA,TPASS,TPCN,TMAX,TMP,TOA,TNPC 80 S TM="" 81 F S TM=$O(^SCTM(404.57,"C",TM)) Q:TM="" D 82 .;$O through team position file 83 .I '$D(TEAM(TM))&(TEAM'=1) Q 84 .;Q above, not a selected team 85 .;selected team 86 .S EN="" 87 .S TPASS(TM)=0,TMAX(TM)=0,TPCN(TM)=0 88 .F S EN=$O(^SCTM(404.57,"C",TM,EN)) Q:EN="" D 89 ..I '$D(^SCTM(404.57,EN,0)) Q 90 ..S NODE=$G(^SCTM(404.57,EN,0)) 91 ..Q:NODE="" 92 ..S ROL=+$P(NODE,"^",3) ;role ien 93 ..I '$D(ROLE(ROL))&(ROLE'=1) Q 94 ..;Q above not a selected role 95 ..;find active position during date range 96 ..S TMP=$$DATES^SCAPMCU1(404.52,EN,DT) 97 ..I +TMP=0 Q 98 ..S EN2=+$P(TMP,"^",4) 99 ..D KEEP^SCRPSLT2(NODE,EN,EN2,ROL,TM,.TPCN,.TNPC) 100 ..S TPASS(TM)=$$TEAMCNT^SCAPMCU1(TM,DT) 101 ..S TMAX(TM)=+$P($G(^SCTM(404.51,+TM,0)),U,8) 102 ..S TOA(TM)=TMAX(TM)-TPASS(TM) S:TOA(TM)<0 TOA(TM)=0 103 ..D TEAMT^SCRPSLT2(TM,.TPASS,.TMAX,.TPCN,.TOA,.TNPC) 104 Q 105 ; 106 PRINTIT(STORE,TITL) ; 107 N INST,EINST,ETEAM,TEM,EPRACT,PRACT,NXT,PAGE,NPAGE,NEW,POS,SCAC 108 S (INST,EINST)="",(NPAGE,STOP)=0,PAGE=1 W:$E(IOST)="C" @IOF 109 D TITLE^SCRPU3(.PAGE,TITL) 110 D FORHEAD^SCRPSLT2 111 F S EINST=$O(@STORE@("I",EINST)) Q:EINST=""!(STOP) D 112 .S INST=$O(@STORE@("I",EINST,"")) 113 .I INST="" Q 114 .S (TEM,ETEAM)="" 115 .F S ETEAM=$O(@STORE@("T",INST,ETEAM)) Q:ETEAM=""!(STOP) D 116 ..S TEM=$O(@STORE@("T",INST,ETEAM,"")) 117 ..I TEM="" Q 118 ..K NEW 119 ..I NPAGE,(IOST'?1"C-".E) D NEWP^SCRPSLT2(INST,TEM,TITL,.PAGE) S NEW="" 120 ..I NPAGE,(IOST?1"C-".E) D HOLD1^SCRPSLT2(.PAGE,TITL,INST,TEM) S NEW="" 121 ..S NPAGE=1 I STOP Q 122 ..I IOST'?1"C-".E,$Y>(IOSL-8) D NEWP^SCRPSLT2(INST,TEM,TITL,.PAGE) S NEW="" 123 ..I IOST?1"C-".E,$Y>(IOSL-8) D HOLD1^SCRPSLT2(.PAGE,TITL,INST,TEM) S NEW="" 124 ..I STOP Q 125 ..I '$D(NEW) D HEADER^SCRPSLT2(INST,TEM) 126 ..S (PRACT,EPRACT)="" 127 ..F S EPRACT=$O(@STORE@("PN",INST,TEM,EPRACT)) Q:EPRACT=""!(STOP) D 128 ...S PRACT=$O(@STORE@("PN",INST,TEM,EPRACT,"")) 129 ...I PRACT="" Q 130 ...S POS="" 131 ...F S POS=$O(@STORE@(INST,TEM,PRACT,POS)) Q:POS=""!(STOP) D 132 ....W !,$G(@STORE@(INST,TEM,PRACT,POS)) 133 ....S SCAC="" 134 ....F S SCAC=$O(@STORE@(INST,TEM,PRACT,POS,SCAC)) Q:SCAC=""!(STOP) D 135 .....W !,$G(@STORE@(INST,TEM,PRACT,POS,SCAC)) 136 .....I IOST'?1"C-".E,$Y>(IOSL-4) D NEWP^SCRPSLT2(INST,TEM,TITL,.PAGE) 137 .....I IOST?1"C-".E,$Y>(IOSL-4) D HOLD1^SCRPSLT2(.PAGE,TITL,INST,TEM) 138 .....I STOP Q 139 ....;W !,$G(@STORE@(INST,TEM,PRACT,POS)) ;writes info 140 ..Q:STOP 141 ..I IOST'?1"C-".E,$Y>(IOSL-8) D NEWP^SCRPSLT2(INST,TEM,TITL,.PAGE,1) 142 ..I IOST?1"C-".E,$Y>(IOSL-8) D HOLD1^SCRPSLT2(.PAGE,TITL,INST,TEM,1) 143 ..D TOTAL^SCRPSLT2(INST,TEM) 144 .I STOP Q 145 .S NPAGE=1 146 I 'STOP,$E(IOST)="C" N DIR S DIR(0)="E" D ^DIR 147 Q 1 SCRPSLT ;ALB/CMM - Summary Listing of Teams ; 29 Jun 99 04:11PM 2 ;;5.3;Scheduling;**41,52,177,231**;AUG 13, 1993 3 ; 4 ;Summary Listing of Teams Report 5 ; 6 PROMPTS ; 7 ;Prompt for Institution, Team, Role and Print device 8 ; 9 N VAUTD,VAUTT,VAUTR,QTIME,PRNT,NUMBER 10 K VAUTD,VAUTT,VAUTR,SCUP 11 S QTIME="" 12 W ! D INST^SCRPU1 I Y=-1 G ERR 13 W ! K Y D PRMTT^SCRPU1 I '$D(VAUTT) G ERR 14 W ! K Y D ROLE^SCRPU1 I '$D(VAUTR) G ERR 15 W !!,"This report requires 132 column output!" 16 D QUE(.VAUTD,.VAUTT,.VAUTR) Q 17 ; 18 QUE(INST,TEAM,ROLE) ;queue report 19 ;Input Parameters: 20 ;INST - institutions selected (variable and array) 21 ;TEAM - teams selected (variable and array) 22 ;ROLE - roles selected (variable and array) 23 N ZTSAVE,II 24 F II="INST","TEAM","ROLE","INST(","TEAM(","ROLE(" S ZTSAVE(II)="" 25 W ! D EN^XUTMDEVQ("QENTRY^SCRPSLT","Summary Listing of Teams",.ZTSAVE) 26 Q 27 ; 28 ENTRY2(INST,TEAM,ROLE,IOP,ZTDTH) ; 29 ;Second entry point for GUI to use 30 ;Input Parameters: 31 ;INST - institutions selected (variable and array) 32 ;TEAM - teams selected (variable and array) 33 ;ROLE - roles selected (variable and array) 34 ;IOP - print device 35 ;ZTDTH - queue time (optional) 36 ; 37 ;validate parameters 38 I '$D(INST)!'$D(TEAM)!'$D(ROLE)!'$D(IOP)!(IOP="") Q 39 ; 40 N NUMBER 41 S IOST=$P(IOP,"^",2),IOP=$P(IOP,"^") 42 I IOP?1"Q;".E S IOP=$P(IOP,"Q;",2) 43 I IOST?1"C-".E D QENTRY G RET 44 I ZTDTH="" S ZTDTH=$H 45 S ZTRTN="QENTRY^SCRPSLT" 46 S ZTDESC="Summary Listing Of Teams",ZTIO=IOP 47 N II 48 F II="INST","TEAM","ROLE","INST(","TEAM(","ROLE(","IOP" S ZTSAVE(II)="" 49 D ^%ZTLOAD 50 RET S NUMBER=0 51 I $D(ZTSK) S NUMBER=ZTSK 52 D EXIT1 53 Q NUMBER 54 ; 55 QENTRY ; 56 ;driver entry point 57 S TITL="Summary Listing of Teams" 58 S STORE="^TMP("_$J_",""SCRPSLT"")" 59 K @STORE 60 S @STORE=0 61 I TEAM=1 D TALL^SCRPPAT3 S TEAM=0 62 D FIND 63 I $O(@STORE@(0))="" S NODATA=$$NODATA^SCRPU3(TITL) 64 I '$D(NODATA) D PRINTIT(STORE,TITL) 65 D EXIT2 66 Q 67 ; 68 ERR ; 69 EXIT1 ; 70 K ZTDTH,ZTRTN,ZTDESC,ZTSK,ZTIO,ZTSAVE,SCUP 71 Q 72 ; 73 EXIT2 ; 74 K @STORE 75 K STOP,STORE,TITL,IOP,TEAM,INST,ROLE,NODATA 76 Q 77 ; 78 FIND ; 79 N TM,EN2,EN,ROL,NODE,TEND,ACT,INA,TPASS,TPCN,TMAX,TMP,TOA,TNPC 80 S TM="" 81 F S TM=$O(^SCTM(404.57,"C",TM)) Q:TM="" D 82 .;$O through team position file 83 .I '$D(TEAM(TM))&(TEAM'=1) Q 84 .;Q above, not a selected team 85 .;selected team 86 .S EN="" 87 .S TPASS(TM)=0,TMAX(TM)=0,TPCN(TM)=0 88 .F S EN=$O(^SCTM(404.57,"C",TM,EN)) Q:EN="" D 89 ..I '$D(^SCTM(404.57,EN,0)) Q 90 ..S NODE=$G(^SCTM(404.57,EN,0)) 91 ..Q:NODE="" 92 ..S ROL=+$P(NODE,"^",3) ;role ien 93 ..I '$D(ROLE(ROL))&(ROLE'=1) Q 94 ..;Q above not a selected role 95 ..;find active position during date range 96 ..S TMP=$$DATES^SCAPMCU1(404.52,EN,DT) 97 ..I +TMP=0 Q 98 ..S EN2=+$P(TMP,"^",4) 99 ..D KEEP^SCRPSLT2(NODE,EN,EN2,ROL,TM,.TPCN,.TNPC) 100 ..S TPASS(TM)=$$TEAMCNT^SCAPMCU1(TM,DT) 101 ..S TMAX(TM)=+$P($G(^SCTM(404.51,+TM,0)),U,8) 102 ..S TOA(TM)=TMAX(TM)-TPASS(TM) S:TOA(TM)<0 TOA(TM)=0 103 ..D TEAMT^SCRPSLT2(TM,.TPASS,.TMAX,.TPCN,.TOA,.TNPC) 104 Q 105 ; 106 PRINTIT(STORE,TITL) ; 107 N INST,EINST,ETEAM,TEM,EPRACT,PRACT,NXT,PAGE,NPAGE,NEW,POS 108 S (INST,EINST)="",(NPAGE,STOP)=0,PAGE=1 W:$E(IOST)="C" @IOF 109 D TITLE^SCRPU3(.PAGE,TITL) 110 D FORHEAD^SCRPSLT2 111 F S EINST=$O(@STORE@("I",EINST)) Q:EINST=""!(STOP) D 112 .S INST=$O(@STORE@("I",EINST,"")) 113 .I INST="" Q 114 .S (TEM,ETEAM)="" 115 .F S ETEAM=$O(@STORE@("T",INST,ETEAM)) Q:ETEAM=""!(STOP) D 116 ..S TEM=$O(@STORE@("T",INST,ETEAM,"")) 117 ..I TEM="" Q 118 ..K NEW 119 ..I NPAGE,(IOST'?1"C-".E) D NEWP^SCRPSLT2(INST,TEM,TITL,.PAGE) S NEW="" 120 ..I NPAGE,(IOST?1"C-".E) D HOLD1^SCRPSLT2(.PAGE,TITL,INST,TEM) S NEW="" 121 ..S NPAGE=1 I STOP Q 122 ..I IOST'?1"C-".E,$Y>(IOSL-8) D NEWP^SCRPSLT2(INST,TEM,TITL,.PAGE) S NEW="" 123 ..I IOST?1"C-".E,$Y>(IOSL-8) D HOLD1^SCRPSLT2(.PAGE,TITL,INST,TEM) S NEW="" 124 ..I STOP Q 125 ..I '$D(NEW) D HEADER^SCRPSLT2(INST,TEM) 126 ..S (PRACT,EPRACT)="" 127 ..F S EPRACT=$O(@STORE@("PN",INST,TEM,EPRACT)) Q:EPRACT=""!(STOP) D 128 ...S PRACT=$O(@STORE@("PN",INST,TEM,EPRACT,"")) 129 ...I PRACT="" Q 130 ...S POS="" 131 ...F S POS=$O(@STORE@(INST,TEM,PRACT,POS)) Q:POS=""!(STOP) D 132 ....I IOST'?1"C-".E,$Y>(IOSL-4) D NEWP^SCRPSLT2(INST,TEM,TITL,.PAGE) 133 ....I IOST?1"C-".E,$Y>(IOSL-4) D HOLD1^SCRPSLT2(.PAGE,TITL,INST,TEM) 134 ....I STOP Q 135 ....W !,$G(@STORE@(INST,TEM,PRACT,POS)) ;writes info 136 ..Q:STOP 137 ..I IOST'?1"C-".E,$Y>(IOSL-8) D NEWP^SCRPSLT2(INST,TEM,TITL,.PAGE,1) 138 ..I IOST?1"C-".E,$Y>(IOSL-8) D HOLD1^SCRPSLT2(.PAGE,TITL,INST,TEM,1) 139 ..D TOTAL^SCRPSLT2(INST,TEM) 140 .I STOP Q 141 .S NPAGE=1 142 I 'STOP,$E(IOST)="C" N DIR S DIR(0)="E" D ^DIR 143 Q
Note:
See TracChangeset
for help on using the changeset viewer.
