CRHD7 ; CAIRO/CLC - TEAM ROSTER ;4/22/08 12:53
;;1.0;CRHD;****;Jan 28, 2008;Build 19
;=================================================================
MGR(CRHDRTN,DUZ) ;check for the Manager key
N CRHDKN,CRHDOUT
S CRHDRTN=0
S CRHDKN=$$FIND1^DIC(19.1,"","X","CRHD SHIFT CHG HANDOFF MGR","","","CRHDOUT")
D GETS^DIQ(200,DUZ_",","51*","I","CRHDOUT")
I CRHDKN>0 S CRHDRTN=$D(CRHDOUT(200.051,+CRHDKN_","_DUZ_","))
Q
TEAMMEM(CRHDRTN,CRHDTM) ;
N CRHDTMM,CRHDCT,CRHDOP,CRHDPG,CRHDX1,CRHDRM,CRHDEM
N CRHDTT,CRHDSORT,CRHDTTCT,CRHDTIT,CRHDFG,CRHDUIF,CRHDX
S CRHDCT=1
I $P(CRHDTM,"^",2)="USR" D
.S CRHDTM=$$GET^XPAR("USR.`"_+CRHDTM,"ORLP DEFAULT TEAM",1,"I")
I +CRHDTM D
.I '$D(^OR(100.21,+CRHDTM,0)) K CRHDRTN S CRHDRTN="" Q
.K CRHDTMM
.D TEAMPROV^ORQPTQ1(.CRHDTMM,+CRHDTM)
.I $D(CRHDTMM) D
..S CRHDX1=0
..F S CRHDX1=$O(CRHDTMM(CRHDX1)) Q:'CRHDX1 D
...D DISP^CRHDUD(.CRHDUIF,+CRHDTMM(CRHDX1))
...I $D(CRHDUIF) S CRHDSORT($P(CRHDUIF,"^",2))=CRHDUIF
I $D(CRHDSORT) D
.S CRHDCT=0
.S CRHDX=""
.F S CRHDX=$O(CRHDSORT(CRHDX)) Q:CRHDX="" D
..S CRHDCT=CRHDCT+1
..S CRHDRTN(CRHDCT)=CRHDSORT(CRHDX)
Q
GETMPEXP(CRHDLST,CRHDUSR,CRHDDIV) ;get temp flds expiration time
K CRHDLST
N CRHDPARA,CRHDTITL,CRHDPP
F CRHDPP=1,2,3,4 D
.D GETONEP^CRHD4(.CRHDPARA,CRHDUSR,"TEMP_FLD_"_CRHDPP_"_TITLE",CRHDDIV)
.I $G(CRHDPARA(1))'="" D
..S CRHDTITL=$$UP^XLFSTR(CRHDPARA(1))
..S CRHDLST(CRHDTITL)=""
..K CRHDPARA
..D GETONEP^CRHD4(.CRHDPARA,CRHDUSR,"edt_TEMP_FLD_"_CRHDPP_"_EXPIRE",CRHDDIV)
..I $G(CRHDPARA(1))'="" S CRHDLST(CRHDTITL)=CRHDPARA(1)
Q
DELTMPTX(CRHDFLDA,DA) ;KILL TEXT FOR TEMP FLD DATA
N DIE,DR
S DIE="^CRHD(183.2,"_CRHDFLDA_",1,"
S DA(1)=CRHDFLDA,DR=".01///@"
D ^DIE
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HCRHD7 1747 printed Nov 22, 2024@17:47:47 Page 2
CRHD7 ; CAIRO/CLC - TEAM ROSTER ;4/22/08 12:53
+1 ;;1.0;CRHD;****;Jan 28, 2008;Build 19
+2 ;=================================================================
MGR(CRHDRTN,DUZ) ;check for the Manager key
+1 NEW CRHDKN,CRHDOUT
+2 SET CRHDRTN=0
+3 SET CRHDKN=$$FIND1^DIC(19.1,"","X","CRHD SHIFT CHG HANDOFF MGR","","","CRHDOUT")
+4 DO GETS^DIQ(200,DUZ_",","51*","I","CRHDOUT")
+5 IF CRHDKN>0
SET CRHDRTN=$DATA(CRHDOUT(200.051,+CRHDKN_","_DUZ_","))
+6 QUIT
TEAMMEM(CRHDRTN,CRHDTM) ;
+1 NEW CRHDTMM,CRHDCT,CRHDOP,CRHDPG,CRHDX1,CRHDRM,CRHDEM
+2 NEW CRHDTT,CRHDSORT,CRHDTTCT,CRHDTIT,CRHDFG,CRHDUIF,CRHDX
+3 SET CRHDCT=1
+4 IF $PIECE(CRHDTM,"^",2)="USR"
Begin DoDot:1
+5 SET CRHDTM=$$GET^XPAR("USR.`"_+CRHDTM,"ORLP DEFAULT TEAM",1,"I")
End DoDot:1
+6 IF +CRHDTM
Begin DoDot:1
+7 IF '$DATA(^OR(100.21,+CRHDTM,0))
KILL CRHDRTN
SET CRHDRTN=""
QUIT
+8 KILL CRHDTMM
+9 DO TEAMPROV^ORQPTQ1(.CRHDTMM,+CRHDTM)
+10 IF $DATA(CRHDTMM)
Begin DoDot:2
+11 SET CRHDX1=0
+12 FOR
SET CRHDX1=$ORDER(CRHDTMM(CRHDX1))
if 'CRHDX1
QUIT
Begin DoDot:3
+13 DO DISP^CRHDUD(.CRHDUIF,+CRHDTMM(CRHDX1))
+14 IF $DATA(CRHDUIF)
SET CRHDSORT($PIECE(CRHDUIF,"^",2))=CRHDUIF
End DoDot:3
End DoDot:2
End DoDot:1
+15 IF $DATA(CRHDSORT)
Begin DoDot:1
+16 SET CRHDCT=0
+17 SET CRHDX=""
+18 FOR
SET CRHDX=$ORDER(CRHDSORT(CRHDX))
if CRHDX=""
QUIT
Begin DoDot:2
+19 SET CRHDCT=CRHDCT+1
+20 SET CRHDRTN(CRHDCT)=CRHDSORT(CRHDX)
End DoDot:2
End DoDot:1
+21 QUIT
GETMPEXP(CRHDLST,CRHDUSR,CRHDDIV) ;get temp flds expiration time
+1 KILL CRHDLST
+2 NEW CRHDPARA,CRHDTITL,CRHDPP
+3 FOR CRHDPP=1,2,3,4
Begin DoDot:1
+4 DO GETONEP^CRHD4(.CRHDPARA,CRHDUSR,"TEMP_FLD_"_CRHDPP_"_TITLE",CRHDDIV)
+5 IF $GET(CRHDPARA(1))'=""
Begin DoDot:2
+6 SET CRHDTITL=$$UP^XLFSTR(CRHDPARA(1))
+7 SET CRHDLST(CRHDTITL)=""
+8 KILL CRHDPARA
+9 DO GETONEP^CRHD4(.CRHDPARA,CRHDUSR,"edt_TEMP_FLD_"_CRHDPP_"_EXPIRE",CRHDDIV)
+10 IF $GET(CRHDPARA(1))'=""
SET CRHDLST(CRHDTITL)=CRHDPARA(1)
End DoDot:2
End DoDot:1
+11 QUIT
DELTMPTX(CRHDFLDA,DA) ;KILL TEXT FOR TEMP FLD DATA
+1 NEW DIE,DR
+2 SET DIE="^CRHD(183.2,"_CRHDFLDA_",1,"
+3 SET DA(1)=CRHDFLDA
SET DR=".01///@"
+4 DO ^DIE
+5 QUIT
