source: WorldVistAEHR/trunk/r/ZZREGIONAL-A1C-A5C-CRHD-RGED-RGUT-RGWB-RG/CRHDUD.m@ 1046

CRHDUD  ;CAIRO/CLC - New Person general information ;04-Mar-2008 16:00;CLC;EMPLOYEE DIRECTORY
        ;;1.0;CRHD;****;Jan 28, 2008;Build 19
DISPEMP(CRHDRTN,CRHDEMP)        ;
        K CRHDRTN
        N CRHDUIF
        D DISP(.CRHDUIF,+CRHDEMP)
        I $D(CRHDUIF) S CRHDRTN(1)=CRHDUIF
        Q
DISP(CRHDRTN,CRHDEMP)   ;
        ;COLUMNS
        ;DUZ^NAME^SITE^TITLE^OFFICE PH^PAGER^RM^EMAIL^SRV^MAIL CODE
        N CRHDEXT,CRHDSF,CRHDPG,CRHDRM,CRHDNAM,CRHDTIT,CRHDSRV,CRHDSMC,CRHDSRM,CRHDFAX,CRHDEM
        N CRHDSRVN,CRHDMC
        ;
        K CRHDRTN
        I $$GET1^DIQ(200,+CRHDEMP,.01,"I")="" Q
        S CRHDNAM=$$GET1^DIQ(200,+CRHDEMP_",",.01,"E")
        I $L(CRHDNAM)<2 Q
        I '$$ACTIVE^XUSER(+CRHDEMP) S CRHDNAM=CRHDNAM_" (NOT AN ACTIVE USER)"
        S CRHDTIT=$$GET1^DIQ(200,+CRHDEMP_",",8,"E")
        S CRHDMC=$$GET1^DIQ(200,+CRHDEMP_",",28,"E")               ;MAIL CODE
        S CRHDEXT=$$GET1^DIQ(200,+CRHDEMP_",",.132,"E")            ;OFFICE PHONE
        S CRHDPG=$$GET1^DIQ(200,+CRHDEMP_",",.138,"E")             ;PAGER
        S CRHDEM=$$GET1^DIQ(200,+CRHDEMP_",",.151,"E")             ;EMAIL ADDRESS
        S CRHDRM=$$GET1^DIQ(200,+CRHDEMP_",",.141,"E")             ;ROOM
        S CRHDFAX=$$GET1^DIQ(200,+CRHDEMP_",",.136,"E")            ;FAX
        S CRHDSRV=$$GET1^DIQ(200,+CRHDEMP_",",29,"E")              ;SERVICE
        S CRHDSRVN=$$GET1^DIQ(200,+CRHDEMP_",",29,"I")             ;SERVICE IEN
        ;SERVICE INFORMATION
        S CRHDSMC=$$GET1^DIQ(49,+CRHDSRVN_",",1.5,"E")             ;SERVICE MAIL CODE
        S CRHDSRM=$$GET1^DIQ(200,+CRHDSRVN_",",6,"E")              ;SERVICE LOCATION
        ;DISPLAY INFORMATION
        S CRHDRTN=+CRHDEMP_"^"_CRHDNAM
        S $P(CRHDRTN,"^",3)=$$TITLE^XLFSTR(CRHDTIT)
        S $P(CRHDRTN,"^",4)=CRHDEXT
        S $P(CRHDRTN,"^",5)=CRHDPG
        S $P(CRHDRTN,"^",6)=CRHDRM
        S $P(CRHDRTN,"^",7)=CRHDEM
        S $P(CRHDRTN,"^",8)=CRHDFAX
        S $P(CRHDRTN,"^",9)=CRHDSRV
        S $P(CRHDRTN,"^",10)=CRHDSMC
        ;S $P(CRHDRTN,"^",11)=CRHDSRM
        S $P(CRHDRTN,"^",11)=$TR($P($$SITE^VASITE,"^",2,3),"^","-")
        Q
SRV(CRHDRTN,CRHDSRVN,CRHDDIV)   ;
        K CRHDRTN
        N CRHDUIF,CRHDUSR,CRHDS,CRHDCT,CRHDX,CRHDSORT
        I $D(^VA(200,"E")) D
        .S CRHDUSR=0
        .F  S CRHDUSR=$O(^VA(200,"E",+CRHDSRVN,CRHDUSR)) Q:'CRHDUSR  D
        ..I $$ACTIVE^XUSER(CRHDUSR) D
        ...K CRHDUIF
B       ...D DISP(.CRHDUIF,CRHDUSR)
        ...I $D(CRHDUIF) S:$P(CRHDUIF,"^",3)'="" CRHDSORT($P(CRHDUIF,"^",2))=CRHDUIF
        ;COLUMNS - SEE ABOVE USER
        ;
        ;DISPLAY INFORMATION
        I $D(CRHDSORT) D
        .S CRHDX=""
        .S CRHDCT=0
        .F  S CRHDX=$O(CRHDSORT(CRHDX)) Q:CRHDX=""  D
        ..S CRHDCT=CRHDCT+1
        ..S CRHDRTN(CRHDCT)=CRHDSORT(CRHDX)
        Q
SPEC(CRHDRTN,CRHDSP)    ;
        N CRHDCT,X,CRHDX,CRHDPRV,CRHDPG,CRHDNAM,CRHDS,CRHDUIF,CRHDSORT
        K CRHDRTN
        ;S S="                                   "
        ;S CRHDRTN(1)="Specialty: "_$C(9)_$$GET1^DIQ(45.7,+CRHDSP_",",.01,"E")
        ;S CRHDRTN(2)=""
        ;S CRHDRTN(3)="No provider Found."
        ;S CT=2
        I $D(^DIC(45.7,+CRHDSP,"PRO")) D
        .S X=0
        .F  S X=$O(^DIC(45.7,+CRHDSP,"PRO",X)) Q:'X  D
        ..Q:'$$ACTIVE^XUSER(X)
        ..S CRHDPRV=+$G(^DIC(45.7,+CRHDSP,"PRO",X,0))
        ..D DISP(.CRHDUIF,+CRHDPRV)
        ..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
HOTEAM(CRHDRTN,CRHDTM)  ;
        ;Get HOTeam phone list
        N CRHDX,CRHDPRV,CRHDCT,CRHDSORT,CRHDUIF
        K CRHDRTN
        I '$D(^CRHD(183.3,"B",$P(CRHDTM,"^",2),+CRHDTM)) Q
        S CRHDX=0
        F  S CRHDX=$O(^CRHD(183.3,+CRHDTM,2,CRHDX)) Q:'CRHDX  D
        .S CRHDPRV=+$G(^CRHD(183.3,+CRHDTM,2,CRHDX,0))
        .D DISP(.CRHDUIF,+CRHDPRV)
        .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