| 1 | CRHD4 ; CAIRO/CLC - GET USERS PARAMETERS ;4/22/08 12:52
|
---|
| 2 | ;;1.0;CRHD;****;Jan 28, 2008;Build 19
|
---|
| 3 | ;=================================================================
|
---|
| 4 | GETALLP(CRHDRTN,CRHDUSR,CRHDDIV,CRHDPLEV) ;get all of the users parameters
|
---|
| 5 | N X,X1,X2,CRHDCT,CRHDDOFG,CRHDMN,CRHDP,CRHDRSL,I,CRHDAX
|
---|
| 6 | N CRHDL,CRHDVPTR,CRHDPN
|
---|
| 7 | K CRHDRTN
|
---|
| 8 | S CRHDVPTR("USR")=";VA(200," ;NEW PERSON
|
---|
| 9 | S CRHDVPTR("OTL")=";OR(100.21," ;OE/RR TEAM
|
---|
| 10 | S CRHDVPTR("SRV")=";DIC(49," ;SERVICE/SERVICE
|
---|
| 11 | S CRHDVPTR("DIV")=";DIC(4," ;INSTITUTION
|
---|
| 12 | S CRHDVPTR("TS")=";DIC(45.7," ;TREATING SPECIALTY
|
---|
| 13 | S CRHDVPTR("LOC")=";SC(" ;HOSPITAL LOCATION
|
---|
| 14 | S CRHDVPTR("SD")=";SCTM(404.51," ;SD TEAM
|
---|
| 15 | S CRHDAX=+$G(CRHDPLEV)
|
---|
| 16 | S CRHDL=$L($G(CRHDPLEV),"^")
|
---|
| 17 | I CRHDAX D
|
---|
| 18 | .S CRHDAX=CRHDAX_$G(CRHDVPTR($P(CRHDPLEV,"^",CRHDL)))
|
---|
| 19 | .S CRHDDOFG=$O(^CRHD(183,"B",CRHDAX,0))
|
---|
| 20 | I $G(CRHDPLEV)="" S CRHDDOFG=$$GETPLEV(CRHDUSR,CRHDDIV,0)
|
---|
| 21 | I CRHDDOFG>0 D
|
---|
| 22 | .I CRHDDOFG["VA(200" D USRSET(.CRHDRSL,CRHDDOFG)
|
---|
| 23 | .I $D(CRHDRSL) S CRHDDOFG=$$GETPLEV(CRHDUSR,CRHDDIV,1)
|
---|
| 24 | .S CRHDMN=+CRHDDOFG
|
---|
| 25 | .S (CRHDP,CRHDCT)=0
|
---|
| 26 | .F S CRHDP=$O(^CRHD(183,CRHDMN,1,CRHDP)) Q:'CRHDP D
|
---|
| 27 | ..S CRHDCT=CRHDCT+1
|
---|
| 28 | ..I $P($G(^CRHD(183,CRHDMN,1,CRHDP,0)),"^",2)="" D
|
---|
| 29 | ...S X2=0 F S X2=$O(^CRHD(183,CRHDMN,1,CRHDP,1,X2)) Q:'X2 D
|
---|
| 30 | ....I $D(CRHDRSL($P($G(^CRHD(183,CRHDMN,1,CRHDP,0)),"^",1))) Q
|
---|
| 31 | ....;I $D(CRHDRSL("STUDENT")) Q
|
---|
| 32 | ....S CRHDRTN(CRHDCT)=$P($G(^CRHD(183,CRHDMN,1,CRHDP,0)),"^",1)_"^"_$G(^CRHD(183,CRHDMN,1,CRHDP,1,X2,0))
|
---|
| 33 | ....S CRHDCT=CRHDCT+1
|
---|
| 34 | ..E S CRHDRTN(CRHDCT)=$G(^CRHD(183,CRHDMN,1,CRHDP,0))
|
---|
| 35 | I $D(CRHDRSL) D
|
---|
| 36 | .S CRHDPN=""
|
---|
| 37 | .F S CRHDPN=$O(CRHDRSL(CRHDPN)) Q:CRHDPN="" D
|
---|
| 38 | ..S CRHDX=0
|
---|
| 39 | ..F S CRHDX=$O(CRHDRSL(CRHDPN,CRHDX)) Q:'CRHDX S CRHDCT=CRHDCT+1,CRHDRTN(CRHDCT)=CRHDRSL(CRHDPN,CRHDX)
|
---|
| 40 | Q
|
---|
| 41 | USRSET(CRHDLST,CRHDDA) ;
|
---|
| 42 | N CRHDFG,CRHDX,CRHDP0,CRHDCT,CRHDX1
|
---|
| 43 | S (CRHDX,CRHDFG,CRHDCT)=0
|
---|
| 44 | F S CRHDX=$O(^CRHD(183,+CRHDDA,1,CRHDX)) Q:'CRHDX D
|
---|
| 45 | .S CRHDP0=$G(^CRHD(183,+CRHDDA,1,CRHDX,0))
|
---|
| 46 | .I $P(CRHDP0,"^",2)="" D
|
---|
| 47 | ..S CRHDX1=0
|
---|
| 48 | ..F S CRHDX1=$O(^CRHD(183,+CRHDDA,1,CRHDX,1,CRHDX1)) Q:'CRHDX1 S CRHDCT=CRHDCT+1,CRHDLST(CRHDP0,CRHDCT)=$P(CRHDP0,"^",1)_"^"_$G(^CRHD(183,+CRHDDA,1,CRHDX,1,CRHDX1,0))
|
---|
| 49 | .E S CRHDCT=CRHDCT+1,CRHDLST($P(CRHDP0,"^",1),CRHDCT)=CRHDP0
|
---|
| 50 | Q
|
---|
| 51 | GETONEP(CRHDRTN,CRHDE,PNAME) ;Get one parameter from file 183
|
---|
| 52 | N CRHDPAR,Y,X,CRHDCT,CRHDMN,CRHDP,CRHDE1,CRHDE2,CRHDE3,CRHDE4
|
---|
| 53 | N CRHDX2,CRHDRSL,CRHDL,CRHDXCT,CRHDTRSL,CRHDEX,CRHDEE
|
---|
| 54 | S Y=-1
|
---|
| 55 | S CRHDE1=+CRHDE ;internal entry number to file
|
---|
| 56 | S CRHDE2=$P(CRHDE,"^",2) ;name
|
---|
| 57 | S CRHDE3=$P($P(CRHDE,"^",3),"-",1) ;types
|
---|
| 58 | ; USR - New Person
|
---|
| 59 | ; OTL - OE/RR Team
|
---|
| 60 | ; SRV - Service/Section
|
---|
| 61 | ; DIV-Institution;
|
---|
| 62 | ;
|
---|
| 63 | S CRHDCT=0
|
---|
| 64 | S CRHDL=$L(CRHDE,"^")
|
---|
| 65 | S CRHDE4="DIV.`"_$P($P(CRHDE,"^",CRHDL),"-",2) ;User Sign in Division
|
---|
| 66 | I $P(CRHDE4,"`",2)="" D USERDIV^CRHD5(.CRHDEE,DUZ) S CRHDE4="DIV.`"_$G(CRHDEE(1))
|
---|
| 67 | S CRHDPAR=CRHDE3_".`"_CRHDE1
|
---|
| 68 | I CRHDPAR'="" D LOOKUP^XPAREDIT(CRHDPAR,183)
|
---|
| 69 | I Y>-1 D
|
---|
| 70 | .S CRHDMN=+Y
|
---|
| 71 | .S CRHDP=$O(^CRHD(183,CRHDMN,1,"B",PNAME,0))
|
---|
| 72 | .Q:'CRHDP
|
---|
| 73 | .I $P($G(^CRHD(183,CRHDMN,1,+CRHDP,0)),"^",2)="" D
|
---|
| 74 | ..S CRHDX2=0 F S CRHDX2=$O(^CRHD(183,CRHDMN,1,+CRHDP,1,CRHDX2)) Q:'CRHDX2 D
|
---|
| 75 | ...S CRHDCT=CRHDCT+1,CRHDRTN(CRHDCT)=$G(^CRHD(183,CRHDMN,1,+CRHDP,1,CRHDX2,0))
|
---|
| 76 | .E S CRHDRTN(1)=$P($G(^CRHD(183,CRHDMN,1,+CRHDP,0)),"^",2)
|
---|
| 77 | Q
|
---|
| 78 | GETDNRT(CRHDRTN,CRHDUSR,CRHDDIV) ;get DNR Titles
|
---|
| 79 | K CRHDRTN
|
---|
| 80 | N CRHDDNR,CRHDX
|
---|
| 81 | D DNRPARM^CRHDDNR(.CRHDDNR,DUZ,CRHDDIV)
|
---|
| 82 | I $D(CRHDDNR) D
|
---|
| 83 | .S CRHDX=0 F S CRHDX=$O(CRHDDNR(CRHDX)) Q:'CRHDX S CRHDRTN(CRHDX)=$P(CRHDDNR(CRHDX),"^",2)
|
---|
| 84 | Q
|
---|
| 85 | SAVEPARM(CRHDRTN,CRHDLEV,CRHDPAR,CRHDVAL,CRHDTXT) ;save parameters
|
---|
| 86 | N Y,CRHDFN,CRHDFDA,CRHDERR,CRHDOUT,CRHDFILE,CRHDXX,CRHDUPY,CRHDUPZ
|
---|
| 87 | N CRHDIENS,CRHDFLAG,CRHDANS,CRHDVPTR,CRHDL,DIE,DR,DA,CRHDAX
|
---|
| 88 | S CRHDVPTR("USR")=";VA(200," ;NEW PERSON
|
---|
| 89 | S CRHDVPTR("OTL")=";OR(100.21," ;OE/RR TEAM
|
---|
| 90 | S CRHDVPTR("SRV")=";DIC(49," ;SERVICE/SERVICE
|
---|
| 91 | S CRHDVPTR("DIV")=";DIC(4," ;INSTITUTION
|
---|
| 92 | ;S CRHDVPTR("TS")=";DIC(45.7," ;TREATING SPECIALTY
|
---|
| 93 | ;S CRHDVPTR("LOC")=";SC(" ;HOSPITAL LOCATION
|
---|
| 94 | ;S CRHDVPTR("SD")=";SCTM(404.51," ;SD TEAM
|
---|
| 95 | S CRHDFN=183 ;CRHD PARAMETER FILE NUMBER
|
---|
| 96 | B K CRHDRTN
|
---|
| 97 | S CRHDRTN(0)="0^NO DATA STORED"
|
---|
| 98 | I $D(CRHDTXT)&((CRHDPAR="")&(CRHDVAL="")) D SAVELIST(.CRHDRTN,.CRHDLEV,.CRHDTXT) Q
|
---|
| 99 | I CRHDPAR="" S CRHDRTN(0)="0^PARAMETER NAME MISSING" Q
|
---|
| 100 | S CRHDUPY=$$CHK(CRHDLEV)
|
---|
| 101 | S CRHDUPZ=$P(CRHDUPY,"^",2)
|
---|
| 102 | S CRHDAX=$P(CRHDUPY,"^",3)
|
---|
| 103 | S CRHDL=$L(CRHDLEV,"^")
|
---|
| 104 | I CRHDAX<1 S CRHDAX=+CRHDLEV_$G(CRHDVPTR($P(CRHDLEV,"^",CRHDL)))
|
---|
| 105 | I +CRHDAX S CRHDFDA(CRHDFN,CRHDUPZ,.01)=CRHDAX
|
---|
| 106 | I CRHDUPZ="+1," D
|
---|
| 107 | .D UPDATE^DIE("","CRHDFDA","CRHDOUT","CRHDERR")
|
---|
| 108 | .I '$D(CRHDERR) S CRHDUPZ=CRHDOUT(1)_",",CRHDRTN(0)=1
|
---|
| 109 | .K CRHDFDA,CRHDOUT,CRHDERR
|
---|
| 110 | .S CRHDFDA(CRHDFN,CRHDUPZ,.01)=CRHDAX
|
---|
| 111 | I $D(CRHDFDA) D
|
---|
| 112 | .S CRHDFDA(CRHDFN_".01","?+2,"_CRHDUPZ,.01)=CRHDPAR
|
---|
| 113 | .S:CRHDVAL'="" CRHDFDA(CRHDFN_".01","?+2,"_CRHDUPZ,1)=CRHDVAL
|
---|
| 114 | .D UPDATE^DIE("","CRHDFDA","CRHDOUT","CRHDERR")
|
---|
| 115 | .I '$D(CRHDERR) S CRHDMX=$G(CRHDOUT(2)),CRHDRTN(0)=1
|
---|
| 116 | .I $D(CRHDTXT) D
|
---|
| 117 | .S CRHDXX=0 F S CRHDXX=$O(^CRHD(CRHDFN,+CRHDUPZ,1,CRHDMX,1,CRHDXX)) Q:'CRHDXX D
|
---|
| 118 | ..S DIE="^CRHD("_CRHDFN_","_CRHDUPZ_"1,"_CRHDMX_",1,",DA=CRHDXX,DR=".01///@"
|
---|
| 119 | ..S DA(2)=+CRHDUPZ,DA(1)=CRHDMX
|
---|
| 120 | ..D ^DIE
|
---|
| 121 | .S CRHDX=0
|
---|
| 122 | .F S CRHDX=$O(CRHDTXT(CRHDX)) Q:'CRHDX D
|
---|
| 123 | ..S CRHDFDA(CRHDFN_.12,"?+"_(CRHDX+1)_","_CRHDMX_","_CRHDUPZ_"",.01)=$S($D(CRHDTXT(CRHDX,0)):CRHDTXT(CRHDX,0),1:CRHDTXT(CRHDX))
|
---|
| 124 | .D:$D(CRHDFDA) UPDATE^DIE("","CRHDFDA","CRHDOUT","CRHDERR")
|
---|
| 125 | .I '$D(CRHDERR) S CRHDRTN(0)=1
|
---|
| 126 | .E S CRHDRTN(0)="0^ERROR ENCOUNTERED STORING DATA"
|
---|
| 127 | K CRHDFDA,CRHDOUT,CRHDERR
|
---|
| 128 | Q
|
---|
| 129 | SAVELIST(CRHDRTN,CRHDLEV,CRHDTXT) ;process list of parameters
|
---|
| 130 | ;list in the format:PARAMETER:VALUE
|
---|
| 131 | N CRHDI,CRHDPAR,CRHDVAL,CRHDFDA,CRHDUPY,CRHDUPZ,CRHDAX,CRHDL
|
---|
| 132 | K CRHDRTN
|
---|
| 133 | S CRHDRTN(0)=0_"^DATA NOT STORED"
|
---|
| 134 | S CRHDUPY=$$CHK(CRHDLEV)
|
---|
| 135 | S CRHDUPZ=$P(CRHDUPY,"^",2)
|
---|
| 136 | S CRHDAX=$P(CRHDUPY,"^",3)
|
---|
| 137 | S CRHDL=$L(CRHDLEV,"^")
|
---|
| 138 | I CRHDAX<1 S CRHDAX=+CRHDLEV_$G(CRHDVPTR($P(CRHDLEV,"^",CRHDL)))
|
---|
| 139 | I +CRHDAX S CRHDFDA(CRHDFN,CRHDUPZ,.01)=CRHDAX
|
---|
| 140 | I CRHDUPZ="+1," D
|
---|
| 141 | .D UPDATE^DIE("","CRHDFDA","CRHDOUT","CRHDERR")
|
---|
| 142 | .I '$D(CRHDERR) S CRHDUPZ=CRHDOUT(1)_",",CRHDRTN(0)=1
|
---|
| 143 | .K CRHDFDA,CRHDOUT,CRHDERR
|
---|
| 144 | S CRHDFDA(CRHDFN,CRHDUPZ,.01)=CRHDAX
|
---|
| 145 | S CRHDI=0
|
---|
| 146 | F S CRHDI=$O(CRHDTXT(CRHDI)) Q:'CRHDI D
|
---|
| 147 | .S CRHDPAR=$P(CRHDTXT(CRHDI),":",1)
|
---|
| 148 | .S CRHDVAL=$P(CRHDTXT(CRHDI),":",2,10)
|
---|
| 149 | .Q:CRHDPAR=""
|
---|
| 150 | .I CRHDVAL="" D DELPAR(+CRHDUPZ,CRHDPAR) Q
|
---|
| 151 | .I $D(CRHDFDA) D
|
---|
| 152 | ..S CRHDFDA(CRHDFN_".01","?+"_CRHDI_","_CRHDUPZ,.01)=CRHDPAR
|
---|
| 153 | ..S CRHDFDA(CRHDFN_".01","?+"_CRHDI_","_CRHDUPZ,1)=CRHDVAL
|
---|
| 154 | D UPDATE^DIE("","CRHDFDA","CRHDOUT","CRHDERR")
|
---|
| 155 | I '$D(CRHDERR) S CRHDRTN(0)=1
|
---|
| 156 | E S CRHDRTN(0)="0^ERROR SETTING DATA"
|
---|
| 157 | K CRHDFDA,CRHDOUT,CRHDERR
|
---|
| 158 | Q
|
---|
| 159 | CHK(CRHDL) ;
|
---|
| 160 | N CRHDFLG,Y,CRHDX ;FLG = 1 if record already exist
|
---|
| 161 | S CRHDFLG=0
|
---|
| 162 | I $P(CRHDL,"^",2)'="" D LOOKUP^XPAREDIT($P(CRHDL,"^",2),183)
|
---|
| 163 | I +Y>0 S CRHDX=+Y,CRHDFLG=1
|
---|
| 164 | I CRHDFLG S CRHDFLG=CRHDFLG_"^"_CRHDX_","_"^"_$P(Y,"^",2)
|
---|
| 165 | E S CRHDFLG=CRHDFLG_"^"_"+1,"_"^"_$P(Y,"^",2)
|
---|
| 166 | Q CRHDFLG
|
---|
| 167 | DELPAR(CRHDD1,CRHDDPAR) ;
|
---|
| 168 | N DA,DIE,DR
|
---|
| 169 | Q:'CRHDD1
|
---|
| 170 | S DA=$O(^CRHD(183,+CRHDD1,1,"B",CRHDPAR,0))
|
---|
| 171 | Q:'DA
|
---|
| 172 | S DIE="^CRHD(183,"_CRHDD1_",1,"
|
---|
| 173 | S DR=".01///@",DA(1)=CRHDD1
|
---|
| 174 | D ^DIE
|
---|
| 175 | Q
|
---|
| 176 | GETPLEV(CRHDDUZ,CRHDDIV,CRHDBYU) ;
|
---|
| 177 | N CRHDPAR,CRHDTEAM,CRHDSRV,Y,X,CRHDDIVI
|
---|
| 178 | S Y=-1
|
---|
| 179 | S CRHDTEAM=$$GET^XPAR("USR.`"_CRHDDUZ,"ORLP DEFAULT TEAM",1,"I")
|
---|
| 180 | S CRHDSRV=$$GET1^DIQ(200,CRHDDUZ_",",29,"E")
|
---|
| 181 | S CRHDPAR="USR.`"_CRHDDUZ
|
---|
| 182 | S:CRHDBYU CRHDPAR=""
|
---|
| 183 | I CRHDPAR'="" D LOOKUP^XPAREDIT(CRHDPAR,183)
|
---|
| 184 | I (Y<0)&($G(CRHDTEAM)>0) S CRHDPAR="OTL.`"_+CRHDTEAM D LOOKUP^XPAREDIT(CRHDPAR,183)
|
---|
| 185 | I (Y<0)&($G(CRHDSRV)'="") S CRHDPAR="SRV."_CRHDSRV D LOOKUP^XPAREDIT(CRHDPAR,183)
|
---|
| 186 | I '+$G(CRHDDIV) S CRHDDIV=+$$SITE^VASITE
|
---|
| 187 | I (Y<0) S CRHDPAR="DIV.`"_+CRHDDIV D LOOKUP^XPAREDIT(CRHDPAR,183)
|
---|
| 188 | I (Y<0) D
|
---|
| 189 | .S CRHDDIVI=$O(^DIC(4,"D",CRHDDIV,0))
|
---|
| 190 | .I CRHDDIVI S CRHDPAR="DIV.`"_CRHDDIVI D LOOKUP^XPAREDIT(CRHDPAR,183)
|
---|
| 191 | Q Y
|
---|