Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: CRHD7

CRHD7.m

Go to the documentation of this file.
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