cAN3250(QU) ;Opbouw LOC voor een gebruiker ;%AN3250 [ 11/25/97  10:26 AM ]
 ; 
 ; QU = initialen 
 ;
1 N OK
 S OK=1 I $L($G(^DPAR(0,"PAR","LOC",0))) X ^(0) G 7:OK
 ;
 N UI1,UQC,USC,UQCUCL,USCUCL,UQCCL,USCCL,UI1USR,UREF,IREF,UREFUCL,UREFLOC,UFU,SW3,SW2,I,A,B,UI1P,EIGC
 D DMS^cAN000("UQC","USC","SYS.LOC",1) I '$L(UQC)!'$L(USC) G YZ
 D DMS^cAN000("UQCUCL","USCUCL","USR_SYS.CL",1) I '$L(UQCUCL)!'$L(USCUCL) G YZ
 D DMS^cAN000("UQCCL","USCCL","SYS.CL",1) I '$L(UQCCL)!'$L(USCCL) G YZ
 ;
 ; verwijderen ^LOC(boot,$j) en ^ILOC(boot,$J)
2 S UREF=^DMC(UQC,USC,"DATA","REF"),IREF=^("INDEX")
 K @($P(UREF,",UI1")_")"),@IREF
 ;
 ; ophalen intern nr gebruiker
21 S UI1USR="" I $G(QU)?1.U S UI1USR=$$UR^cAFA1("USR",101,QU)
 S UREFUCL=^DMC(UQCUCL,USCUCL,"DATA","REF")
 S UREFUCL=$P(UREFUCL,",UI1")_",UI1UCL"_$P(UREFUCL,",UI1",2,99)
 S UREFLOC=^DMC(UQCCL,USCCL,"DATA","REF")
 S UREFLOC=$P(UREFLOC,",UI1")_",UI1P"_$P(UREFLOC,",UI1",2,99)
 ;
3 S UFU="O",(SW3,SW2)=1
 ;
4 ; centrale locaties per gebruiker
 S UI1="",UI1=$O(@UREF,-1) S:'UI1 UI1=1000
 S UI1UCL=UI1USR_" "
 F  S UI1UCL=$O(@UREFUCL) Q:$P(UI1UCL," ")'=UI1USR!'$L(UI1UCL)  D
 . I $P(@UREFUCL@(0),D,30) Q
 . S UI1P=$P(@UREFUCL@(0),D,2),EIGC=$P(^(0),D,3)
 . S B(1)=$G(@UREFLOC@(0)) I '$L(B(1)) Q
 . I $P(B(1),D,30) Q
 . S $P(B(1),D,11)=EIGC
 . S UI1=UI1+1
 . D U^cAN000
 ;
7 I $L($G(^DPAR(0,"PAR","LOC",1))) X ^(1)
 ;
YZ Q
 ;
ZZ ; 05.02.01 - 16 u 23 * V7.84