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

CRHD4.m

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