CRHD4 ; CAIRO/CLC - GET USERS PARAMETERS ;4/22/08  12:52
 ;;1.0;CRHD;****;Jan 28, 2008;Build 19
 ;=================================================================
GETALLP(CRHDRTN,CRHDUSR,CRHDDIV,CRHDPLEV) ;get all of the users parameters
 
X,X1,X2,CRHDCT,CRHDDOFG,CRHDMN,CRHDP,CRHDRSL,I,CRHDAX
 
CRHDL,CRHDVPTR,CRHDPN
 
CRHDRTN
 
CRHDVPTR("USR")=";VA(200,"      ;NEW PERSON
 
CRHDVPTR("OTL")=";OR(100.21,"   ;OE/RR TEAM
 
CRHDVPTR("SRV")=";DIC(49,"      ;SERVICE/SERVICE
 
CRHDVPTR("DIV")=";DIC(4,"       ;INSTITUTION
 
CRHDVPTR("TS")=";DIC(45.7,"     ;TREATING SPECIALTY
 
CRHDVPTR("LOC")=";SC("          ;HOSPITAL LOCATION
 
CRHDVPTR("SD")=";SCTM(404.51,"  ;SD TEAM
 
CRHDAX=+$G(CRHDPLEV)
 
CRHDL=$L($G(CRHDPLEV),"^")
 
CRHDAX D
 
.CRHDAX=CRHDAX_$G(CRHDVPTR($P(CRHDPLEV,"^",CRHDL)))
 .
CRHDDOFG=$O(^CRHD(183,"B",CRHDAX,0))
 
I $G(CRHDPLEV)="" CRHDDOFG=$$GETPLEV(CRHDUSR,CRHDDIV,0)
 
CRHDDOFG>0 D
 
.CRHDDOFG["VA(200" USRSET(.CRHDRSL,CRHDDOFG)
 .
I $D(CRHDRSLCRHDDOFG=$$GETPLEV(CRHDUSR,CRHDDIV,1)
 .
CRHDMN=+CRHDDOFG
 
.(CRHDP,CRHDCT)=0
 .
F  S CRHDP=$O(^CRHD(183,CRHDMN,1,CRHDP)) Q:'CRHDP  D
 
..CRHDCT=CRHDCT+1
 ..
I $P($G(^CRHD(183,CRHDMN,1,CRHDP,0)),"^",2)="" D
 
...X2=0 F  S X2=$O(^CRHD(183,CRHDMN,1,CRHDP,1,X2)) Q:'X2  D
 
....I $D(CRHDRSL($P($G(^CRHD(183,CRHDMN,1,CRHDP,0)),"^",1))) Q
 
....;I $D(CRHDRSL("STUDENT")) Q
 
....CRHDRTN(CRHDCT)=$P($G(^CRHD(183,CRHDMN,1,CRHDP,0)),"^",1)_"^"_$G(^CRHD(183,CRHDMN,1,CRHDP,1,X2,0))
 ....
CRHDCT=CRHDCT+1
 ..
E  S CRHDRTN(CRHDCT)=$G(^CRHD(183,CRHDMN,1,CRHDP,0))
 
I $D(CRHDRSLD
 
.CRHDPN=""
 
.F  S CRHDPN=$O(CRHDRSL(CRHDPN)) Q:CRHDPN=""  D
 
..CRHDX=0
 ..
F  S CRHDX=$O(CRHDRSL(CRHDPN,CRHDX)) Q:'CRHDX  CRHDCT=CRHDCT+1,CRHDRTN(CRHDCT)=CRHDRSL(CRHDPN,CRHDX)
 
Q
USRSET(CRHDLST,CRHDDA) ;
 
CRHDFG,CRHDX,CRHDP0,CRHDCT,CRHDX1
 
(CRHDX,CRHDFG,CRHDCT)=0
 
F  S CRHDX=$O(^CRHD(183,+CRHDDA,1,CRHDX)) Q:'CRHDX  D
 
.CRHDP0=$G(^CRHD(183,+CRHDDA,1,CRHDX,0))
 .
I $P(CRHDP0,"^",2)="" D
 
..CRHDX1=0
 ..
F  S CRHDX1=$O(^CRHD(183,+CRHDDA,1,CRHDX,1,CRHDX1)) Q:'CRHDX1  CRHDCT=CRHDCT+1,CRHDLST(CRHDP0,CRHDCT)=$P(CRHDP0,"^",1)_"^"_$G(^CRHD(183,+CRHDDA,1,CRHDX,1,CRHDX1,0))
 .
E  S CRHDCT=CRHDCT+1,CRHDLST($P(CRHDP0,"^",1),CRHDCT)=CRHDP0
 
Q
GETONEP(CRHDRTN,CRHDE,PNAME) ;Get one parameter from file 183
 
CRHDPAR,Y,X,CRHDCT,CRHDMN,CRHDP,CRHDE1,CRHDE2,CRHDE3,CRHDE4
 
CRHDX2,CRHDRSL,CRHDL,CRHDXCT,CRHDTRSL,CRHDEX,CRHDEE
 
Y=-1
 
CRHDE1=+CRHDE                          ;internal entry number to file
 
CRHDE2=$P(CRHDE,"^",2)                 ;name
 
CRHDE3=$P($P(CRHDE,"^",3),"-",1)       ;types
 ;                                      USR - New Person
 ;                                      OTL - OE/RR Team
 ;                                      SRV - Service/Section
 ;                                      DIV-Institution;
 ;
 
CRHDCT=0
 
CRHDL=$L(CRHDE,"^")
 
CRHDE4="DIV.`"_$P($P(CRHDE,"^",CRHDL),"-",2)                  ;User Sign in Division
 
I $P(CRHDE4,"`",2)="" USERDIV^CRHD5(.CRHDEE,DUZCRHDE4="DIV.`"_$G(CRHDEE(1))
 
CRHDPAR=CRHDE3_".`"_CRHDE1
 
CRHDPAR'="" LOOKUP^XPAREDIT(CRHDPAR,183)
 
Y>-1 D
 
.CRHDMN=+Y
 
.CRHDP=$O(^CRHD(183,CRHDMN,1,"B",PNAME,0))
 .
Q:'CRHDP
 
.I $P($G(^CRHD(183,CRHDMN,1,+CRHDP,0)),"^",2)="" D
 
..CRHDX2=0 F  S CRHDX2=$O(^CRHD(183,CRHDMN,1,+CRHDP,1,CRHDX2)) Q:'CRHDX2  D
 
...CRHDCT=CRHDCT+1,CRHDRTN(CRHDCT)=$G(^CRHD(183,CRHDMN,1,+CRHDP,1,CRHDX2,0))
 .
E  S CRHDRTN(1)=$P($G(^CRHD(183,CRHDMN,1,+CRHDP,0)),"^",2)
 
Q
GETDNRT(CRHDRTN,CRHDUSR,CRHDDIV) ;get DNR Titles
 
CRHDRTN
 
CRHDDNR,CRHDX
 
DNRPARM^CRHDDNR(.CRHDDNR,DUZ,CRHDDIV)
 
I $D(CRHDDNRD
 
.CRHDX=0 F  S CRHDX=$O(CRHDDNR(CRHDX)) Q:'CRHDX  CRHDRTN(CRHDX)=$P(CRHDDNR(CRHDX),"^",2)
 
Q
SAVEPARM(CRHDRTN,CRHDLEV,CRHDPAR,CRHDVAL,CRHDTXT) ;save parameters
 
Y,CRHDFN,CRHDFDA,CRHDERR,CRHDOUT,CRHDFILE,CRHDXX,CRHDUPY,CRHDUPZ
 
CRHDIENS,CRHDFLAG,CRHDANS,CRHDVPTR,CRHDL,DIE,DR,DA,CRHDAX
 
CRHDVPTR("USR")=";VA(200,"      ;NEW PERSON
 
CRHDVPTR("OTL")=";OR(100.21,"   ;OE/RR TEAM
 
CRHDVPTR("SRV")=";DIC(49,"      ;SERVICE/SERVICE
 
CRHDVPTR("DIV")=";DIC(4,"       ;INSTITUTION
 ;S CRHDVPTR("TS")=";DIC(45.7,"     ;TREATING SPECIALTY
 ;S CRHDVPTR("LOC")=";SC("          ;HOSPITAL LOCATION
 ;S CRHDVPTR("SD")=";SCTM(404.51,"  ;SD TEAM
 
CRHDFN=183  ;CRHD PARAMETER FILE NUMBER
CRHDRTN
 
CRHDRTN(0)="0^NO DATA STORED"
 
I $D(CRHDTXT)&((CRHDPAR="")&(CRHDVAL="")) SAVELIST(.CRHDRTN,.CRHDLEV,.CRHDTXTQ
 I 
CRHDPAR="" CRHDRTN(0)="0^PARAMETER NAME MISSING" Q
 S 
CRHDUPY=$$CHK(CRHDLEV)
 
CRHDUPZ=$P(CRHDUPY,"^",2)
 
CRHDAX=$P(CRHDUPY,"^",3)
 
CRHDL=$L(CRHDLEV,"^")
 
CRHDAX<1 CRHDAX=+CRHDLEV_$G(CRHDVPTR($P(CRHDLEV,"^",CRHDL)))
 
+CRHDAX CRHDFDA(CRHDFN,CRHDUPZ,.01)=CRHDAX
 
CRHDUPZ="+1," D
 
.UPDATE^DIE("","CRHDFDA","CRHDOUT","CRHDERR")
 .
'$D(CRHDERRCRHDUPZ=CRHDOUT(1)_",",CRHDRTN(0)=1
 .
CRHDFDA,CRHDOUT,CRHDERR
 
.CRHDFDA(CRHDFN,CRHDUPZ,.01)=CRHDAX
 
I $D(CRHDFDAD
 
.CRHDFDA(CRHDFN_".01","?+2,"_CRHDUPZ,.01)=CRHDPAR
 
.S:CRHDVAL'="" CRHDFDA(CRHDFN_".01","?+2,"_CRHDUPZ,1)=CRHDVAL
 
.UPDATE^DIE("","CRHDFDA","CRHDOUT","CRHDERR")
 .
'$D(CRHDERRCRHDMX=$G(CRHDOUT(2)),CRHDRTN(0)=1
 .
I $D(CRHDTXTD
 
.CRHDXX=0 F  S CRHDXX=$O(^CRHD(CRHDFN,+CRHDUPZ,1,CRHDMX,1,CRHDXX)) Q:'CRHDXX  D
 
..DIE="^CRHD("_CRHDFN_","_CRHDUPZ_"1,"_CRHDMX_",1,",DA=CRHDXX,DR=".01///@"
 
..DA(2)=+CRHDUPZ,DA(1)=CRHDMX
 
..^DIE
 .
CRHDX=0
 .
F  S CRHDX=$O(CRHDTXT(CRHDX)) Q:'CRHDX  D
 
..CRHDFDA(CRHDFN_.12,"?+"_(CRHDX+1)_","_CRHDMX_","_CRHDUPZ_"",.01)=$S($D(CRHDTXT(CRHDX,0)):CRHDTXT(CRHDX,0),1:CRHDTXT(CRHDX))
 .
D:$D(CRHDFDAUPDATE^DIE("","CRHDFDA","CRHDOUT","CRHDERR")
 .
'$D(CRHDERRCRHDRTN(0)=1
 .
E  S CRHDRTN(0)="0^ERROR ENCOUNTERED STORING DATA"
 
CRHDFDA,CRHDOUT,CRHDERR
 
Q
SAVELIST(CRHDRTN,CRHDLEV,CRHDTXT) ;process list of parameters
 ;list in the format:PARAMETER:VALUE
 
CRHDI,CRHDPAR,CRHDVAL,CRHDFDA,CRHDUPY,CRHDUPZ,CRHDAX,CRHDL
 
CRHDRTN
 
CRHDRTN(0)=0_"^DATA NOT STORED"
 
CRHDUPY=$$CHK(CRHDLEV)
 
CRHDUPZ=$P(CRHDUPY,"^",2)
 
CRHDAX=$P(CRHDUPY,"^",3)
 
CRHDL=$L(CRHDLEV,"^")
 
CRHDAX<1 CRHDAX=+CRHDLEV_$G(CRHDVPTR($P(CRHDLEV,"^",CRHDL)))
 
+CRHDAX CRHDFDA(CRHDFN,CRHDUPZ,.01)=CRHDAX
 
CRHDUPZ="+1," D
 
.UPDATE^DIE("","CRHDFDA","CRHDOUT","CRHDERR")
 .
'$D(CRHDERRCRHDUPZ=CRHDOUT(1)_",",CRHDRTN(0)=1
 .
CRHDFDA,CRHDOUT,CRHDERR
 
CRHDFDA(CRHDFN,CRHDUPZ,.01)=CRHDAX
 
CRHDI=0
 
F  S CRHDI=$O(CRHDTXT(CRHDI)) Q:'CRHDI  D
 
.CRHDPAR=$P(CRHDTXT(CRHDI),":",1)
 .
CRHDVAL=$P(CRHDTXT(CRHDI),":",2,10)
 .
Q:CRHDPAR=""
 
.CRHDVAL="" DELPAR(+CRHDUPZ,CRHDPARQ
 
.I $D(CRHDFDAD
 
..CRHDFDA(CRHDFN_".01","?+"_CRHDI_","_CRHDUPZ,.01)=CRHDPAR
 
..CRHDFDA(CRHDFN_".01","?+"_CRHDI_","_CRHDUPZ,1)=CRHDVAL
 
UPDATE^DIE("","CRHDFDA","CRHDOUT","CRHDERR")
 
'$D(CRHDERRCRHDRTN(0)=1
 
E  S CRHDRTN(0)="0^ERROR SETTING DATA"
 
CRHDFDA,CRHDOUT,CRHDERR
 
Q
CHK(CRHDL) ;
 
CRHDFLG,Y,CRHDX  ;FLG = 1 if record already exist
 
CRHDFLG=0
 
I $P(CRHDL,"^",2)'="" LOOKUP^XPAREDIT($P(CRHDL,"^",2),183)
 
+Y>0 CRHDX=+Y,CRHDFLG=1
 
CRHDFLG CRHDFLG=CRHDFLG_"^"_CRHDX_","_"^"_$P(Y,"^",2)
 
E  S CRHDFLG=CRHDFLG_"^"_"+1,"_"^"_$P(Y,"^",2)
 
CRHDFLG
DELPAR(CRHDD1,CRHDDPAR) ;
 
DA,DIE,DR
 
Q:'CRHDD1
 
DA=$O(^CRHD(183,+CRHDD1,1,"B",CRHDPAR,0))
 
Q:'DA
 
DIE="^CRHD(183,"_CRHDD1_",1,"
 
DR=".01///@",DA(1)=CRHDD1
 
^DIE
 
Q
GETPLEV(CRHDDUZ,CRHDDIV,CRHDBYU) ;
 
CRHDPAR,CRHDTEAM,CRHDSRV,Y,X,CRHDDIVI
 
Y=-1
 
CRHDTEAM=$$GET^XPAR("USR.`"_CRHDDUZ,"ORLP DEFAULT TEAM",1,"I")
 
CRHDSRV=$$GET1^DIQ(200,CRHDDUZ_",",29,"E")
 
CRHDPAR="USR.`"_CRHDDUZ
 
S:CRHDBYU CRHDPAR=""
 
CRHDPAR'="" LOOKUP^XPAREDIT(CRHDPAR,183)
 
(Y<0)&($G(CRHDTEAM)>0) CRHDPAR="OTL.`"_+CRHDTEAM LOOKUP^XPAREDIT(CRHDPAR,183)
 
(Y<0)&($G(CRHDSRV)'=""CRHDPAR="SRV."_CRHDSRV LOOKUP^XPAREDIT(CRHDPAR,183)
 
'+$G(CRHDDIVCRHDDIV=+$$SITE^VASITE
 
(Y<0) CRHDPAR="DIV.`"_+CRHDDIV LOOKUP^XPAREDIT(CRHDPAR,183)
 
(Y<0) D
 
.CRHDDIVI=$O(^DIC(4,"D",CRHDDIV,0))
 .
CRHDDIVI CRHDPAR="DIV.`"_CRHDDIVI LOOKUP^XPAREDIT(CRHDPAR,183)
 
Y