| 1 | SCRPITP ;ALB/CMM - Individual Team Profile ; 29 Jun 99 04:11PM
|
|---|
| 2 | ;;5.3;Scheduling;**41,52,177**;AUG 13, 1993
|
|---|
| 3 | ;
|
|---|
| 4 | ;Individual Team Profile
|
|---|
| 5 | ;
|
|---|
| 6 | PROMPTS ;
|
|---|
| 7 | ;Prompt for Institution, Team, and Print device
|
|---|
| 8 | ;
|
|---|
| 9 | N QTIME,PRNT,VAUTD,VAUTT,Y,NUMBER
|
|---|
| 10 | K VAUTD,VAUTT,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 !!,"This report requires 132 column output!"
|
|---|
| 15 | D QUE(.VAUTD,.VAUTT) Q
|
|---|
| 16 | ;
|
|---|
| 17 | QUE(INST,TEAM) ;queue report
|
|---|
| 18 | ;Input Parameters:
|
|---|
| 19 | ;INST - institutions selected (variable and array)
|
|---|
| 20 | ;TEAM - teams selected (variable and array)
|
|---|
| 21 | N ZTSAVE,II
|
|---|
| 22 | F II="INST","TEAM","INST(","TEAM(" S ZTSAVE(II)=""
|
|---|
| 23 | W ! D EN^XUTMDEVQ("QENTRY^SCRPITP","Individual Team Profile",.ZTSAVE)
|
|---|
| 24 | Q
|
|---|
| 25 | ;
|
|---|
| 26 | ENTRY2(INST,TEAM,IOP,ZTDTH) ;
|
|---|
| 27 | ;Second entry point for GUI to use
|
|---|
| 28 | ;Input Parameters:
|
|---|
| 29 | ;INST - institutions selected (variable and array)
|
|---|
| 30 | ;TEAM - teams selected (variable and array)
|
|---|
| 31 | ;IOP - print device
|
|---|
| 32 | ;ZTDTH - queue time (optional)
|
|---|
| 33 | ;
|
|---|
| 34 | ;validate parameters
|
|---|
| 35 | I '$D(INST)!'$D(TEAM)!'$D(IOP)!(IOP="") Q
|
|---|
| 36 | ;
|
|---|
| 37 | N NUMBER
|
|---|
| 38 | S IOST=$P(IOP,"^",2),IOP=$P(IOP,"^")
|
|---|
| 39 | I IOP?1"Q;".E S IOP=$P(IOP,"Q;",2)
|
|---|
| 40 | I IOST?1"C-".E D QENTRY G RET
|
|---|
| 41 | I ZTDTH="" S ZTDTH=$H
|
|---|
| 42 | S ZTRTN="QENTRY^SCRPITP"
|
|---|
| 43 | S ZTDESC="iIndividual Team Profile",ZTIO=IOP
|
|---|
| 44 | N II
|
|---|
| 45 | F II="INST","TEAM","INST(","TEAM(","IOP" S ZTSAVE(II)=""
|
|---|
| 46 | D ^%ZTLOAD
|
|---|
| 47 | RET S NUMBER=0
|
|---|
| 48 | I $D(ZTSK) S NUMBER=ZTSK
|
|---|
| 49 | D EXIT1
|
|---|
| 50 | Q NUMBER
|
|---|
| 51 | ;
|
|---|
| 52 | QENTRY ;
|
|---|
| 53 | ;driver entry point
|
|---|
| 54 | S TITL="Individual Team Profile"
|
|---|
| 55 | S STORE="^TMP("_$J_",""SCRPITP"")"
|
|---|
| 56 | K @STORE
|
|---|
| 57 | S @STORE=0
|
|---|
| 58 | I TEAM=1 D TALL^SCRPPAT3 S TEAM=0
|
|---|
| 59 | D FIND
|
|---|
| 60 | I $O(@STORE@(0))="" S NODATA=$$NODATA^SCRPU3(TITL)
|
|---|
| 61 | I '$D(NODATA) D PRINTIT(STORE,TITL)
|
|---|
| 62 | D EXIT2
|
|---|
| 63 | Q
|
|---|
| 64 | ;
|
|---|
| 65 | ERR ;
|
|---|
| 66 | EXIT1 ;
|
|---|
| 67 | K ZTDTH,ZTRTN,ZTDESC,ZTSK,ZTIO,ZTSAVE
|
|---|
| 68 | Q
|
|---|
| 69 | ;
|
|---|
| 70 | EXIT2 ;
|
|---|
| 71 | K @STORE
|
|---|
| 72 | K STOP,STORE,TITL,IOP,TEAM,INST,NODATA
|
|---|
| 73 | Q
|
|---|
| 74 | ;
|
|---|
| 75 | FIND ;
|
|---|
| 76 | N TM,EN,NODE,TMP,TPNAME
|
|---|
| 77 | S TM="" K ^TMP("SCRATCH",$J)
|
|---|
| 78 | F S TM=$O(^SCTM(404.57,"C",TM)) Q:TM="" D
|
|---|
| 79 | .;$O through team position file
|
|---|
| 80 | .I '$D(TEAM(TM))&(TEAM'=1) Q
|
|---|
| 81 | .;Q above, not a selected team
|
|---|
| 82 | .;selected team
|
|---|
| 83 | .S EN=""
|
|---|
| 84 | .F S EN=$O(^SCTM(404.57,"C",TM,EN)) Q:EN="" D
|
|---|
| 85 | ..I '$D(^SCTM(404.57,EN,0)) Q
|
|---|
| 86 | ..S NODE=$G(^SCTM(404.57,EN,0))
|
|---|
| 87 | ..Q:NODE=""
|
|---|
| 88 | ..;active or inactive position
|
|---|
| 89 | ..S TMP=$$DATES^SCAPMCU1(404.59,EN,DT)
|
|---|
| 90 | ..S TPNAME=$P(NODE,U) S:'$L(TPNAME) TPNAME="~~~"
|
|---|
| 91 | ..S ^TMP("SCRATCH",$J,TPNAME,EN)=NODE
|
|---|
| 92 | ..I +TMP S ^TMP("SCRATCH",$J,TM,TPNAME,EN)=NODE
|
|---|
| 93 | ..Q
|
|---|
| 94 | .Q
|
|---|
| 95 | S TM=""
|
|---|
| 96 | F S TM=$O(^TMP("SCRATCH",$J,TM)) Q:TM="" S TPNAME="" D
|
|---|
| 97 | .F S TPNAME=$O(^TMP("SCRATCH",$J,TM,TPNAME)) Q:TPNAME="" S EN="" D
|
|---|
| 98 | ..F S EN=$O(^TMP("SCRATCH",$J,TM,TPNAME,EN)) Q:EN="" D
|
|---|
| 99 | ...S NODE=^TMP("SCRATCH",$J,TM,TPNAME,EN)
|
|---|
| 100 | ...D KEEP^SCRPITP2(NODE,EN,TM)
|
|---|
| 101 | ...Q
|
|---|
| 102 | ..Q
|
|---|
| 103 | .Q
|
|---|
| 104 | Q
|
|---|
| 105 | ;
|
|---|
| 106 | PRINTIT(STORE,TITL) ;
|
|---|
| 107 | N INST,EINST,ETEAM,TEM,NEW,PAGE,TNAME,TIEN,EN,SUB,POS,CIEN,INF
|
|---|
| 108 | S (INST,EINST)="",STOP=0,(PAGE,NEW)=1 W:$E(IOST)="C" @IOF
|
|---|
| 109 | D FORHEAD^SCRPITP2
|
|---|
| 110 | F S EINST=$O(@STORE@("I",EINST)) Q:EINST=""!(STOP) D
|
|---|
| 111 | .S INST=$O(@STORE@("I",EINST,""))
|
|---|
| 112 | .I INST="" Q
|
|---|
| 113 | .I STOP Q
|
|---|
| 114 | .;write team info
|
|---|
| 115 | .S TNAME=""
|
|---|
| 116 | .F S TNAME=$O(@STORE@("T",INST,TNAME)) Q:TNAME=""!(STOP) D
|
|---|
| 117 | ..D:NEW TITLE^SCRPU3(.PAGE,TITL,132)
|
|---|
| 118 | ..I 'NEW,$E(IOST)'="C" D NEWP1^SCRPU3(.PAGE,TITL,132)
|
|---|
| 119 | ..I 'NEW,$E(IOST)="C" D HOLD^SCRPU3(.PAGE,TITL,132)
|
|---|
| 120 | ..W !,$G(@STORE@(INST)),! S NEW=""
|
|---|
| 121 | ..S TIEN=$O(@STORE@("T",INST,TNAME,""))
|
|---|
| 122 | ..I TIEN="" Q
|
|---|
| 123 | ..F SUB="TI","D" D
|
|---|
| 124 | ...Q:STOP
|
|---|
| 125 | ...I '$D(@STORE@(INST,TIEN,SUB)) Q
|
|---|
| 126 | ...S EN=""
|
|---|
| 127 | ...F S EN=$O(@STORE@(INST,TIEN,SUB,EN)) Q:EN=""!(STOP) D
|
|---|
| 128 | ....I IOST'?1"C-".E,$Y>(IOSL-5) D NEWP1^SCRPU3(.PAGE,TITL,132)
|
|---|
| 129 | ....I IOST?1"C-".E,$Y>(IOSL-5) D HOLD^SCRPU3(.PAGE,TITL,132)
|
|---|
| 130 | ....I STOP Q
|
|---|
| 131 | ....I '$D(NEW) W !,$G(@STORE@(INST)),!,$G(@STORE@(INST,TIEN)),!
|
|---|
| 132 | ....W !,$G(@STORE@(INST,TIEN,SUB,EN))
|
|---|
| 133 | ...W !
|
|---|
| 134 | ..;write position info
|
|---|
| 135 | ..S POS=""
|
|---|
| 136 | ..I $Y<IOSL-10 D COLUMN^SCRPITP2
|
|---|
| 137 | ..F S POS=$O(@STORE@(INST,TIEN,"P",POS)) Q:POS=""!(STOP) D
|
|---|
| 138 | ...I IOST'?1"C-".E,$Y>(IOSL-5) D NEWP1^SCRPU3(.PAGE,TITL,132) Q:STOP D CONT^SCRPITP2
|
|---|
| 139 | ...I IOST?1"C-".E,$Y>(IOSL-5) D HOLD^SCRPU3(.PAGE,TITL,132) Q:STOP D CONT^SCRPITP2
|
|---|
| 140 | ...I STOP Q
|
|---|
| 141 | ...W !,$G(@STORE@(INST,TIEN,"P",POS))
|
|---|
| 142 | ..W !
|
|---|
| 143 | I 'STOP,$E(IOST)="C" N DIR S DIR(0)="E" W ! D ^DIR
|
|---|
| 144 | Q
|
|---|
