cABCDL(UQA,USA) ; aanmaken CDL-file vanuit DMA, DMC en DMS ; cABCDL [ 03/29/01 9:40 AM ] ; ; UQA en USA meegeven; indien "" of om één of andere reden ongeldig dan worden ze gevraagd ; G 1 ; T0 ; Aanmaken CDL-files ; T1 ;UQA\"[] = synoniemen"; T2 ;USA\"[] = synoniemen"; T3 ;Geen DMS gekoppeld aan ^DMA; T4 ;De aan de DMA gekoppelde DMS bestaat niet; T5 ;DMS\;UQC\;USC\; T6 ;Geen UQC gedefinieerd bij DMS; T7 ;Geen USC gedefinieerd bij DMS; T8 ;Naam klasse\""; T9 ;Naam; T10 ;%Persistent;%SerialObject;%RegisteredObject;%Persistent;%Persistent; T11 ;Type; T12 ;Omschrijving; T13 ;De aan de DMS gekoppelde DMC bestaat niet; T14 ;Indexen : ; T15 ;%String;cInteger;%Numeric;cDate;%Date; T16 ;Unieke key voor de klasse; T17 ;Attributen : ; T18 ;Omschrijving klasse\""; T19 ;Type klasse\"[] = persistent 1[] = embeddable 2[] = registered 3[] = datatype 4[] = afgeleid"; T20 ;SQL-naam klasse\""; T21 ;SQL-naam; T22 ;Bevestiging\"[] = ok ,[] = hernemen xx[] = wijzigen rubriek xx"; T23 ;Klassegegevens; T24 ;Wijzigingen definitief maken\"0[] = neen 1[] = ja" ; ; beginnen met vragen van UQA en USA, en aan de hand daarvan DMS, UQC en USC ophalen ; 1 K ^TEMP(boot,$J+.888) D B^cA612 D T^cA612($P($T(@("T0"_QT)),U,2)_"["""_$ZU($ZV'["MSM"*5)_"""]",1,0,7,0,0) I $L($G(UQA)),$L($G(USA)) D G 29 . W /CUP(4,3),$P($$S1(1,2),D)," :",@F92,UQA,@F93,@F1 . W /CUP(5,3),$P($$S1(2,2),D)," :",@F92,USA,@F93,@F1 I $L($G(UQA)) G 23 ; S K="" 2 S R="UQA\22\3\"_$$S1(1,2)_"\8\\$L(K)\\\1\\1" D R0 I "-,^"[K G YZ 21 I UQA=" " D ^cAN103("UQA",13,"DAM","^DMA_1") I K="-" G 2 I '$D(^DMA(UQA)) S UQA="" G 2 23 W /CUP(4,3),$P($$S1(1,2),D)," :",@F92,UQA,@F93,@F1 25 S R="USA\22\3\"_$$S1(2,2)_"\28\\$L(K)\\\1\\1" D R0 I "-,^"[K G 2 27 I USA=" " D ^cAN103("USA",13,"DAM","^DMA_2") I K="-" G 2 I '$D(^DMA(UQA,USA)) S USA="" G 25 29 W /CUP(5,3),$P($$S1(2,2),D)," :",@F92,USA,@F93,@F1 ; 3 S UREFA="^DMA(UQA,USA)" 31 S DMS=$G(@UREFA@(0,"DMS")) I '$L(DMS) S K=$P($T(@("T3"_QT)),U,2)_"("_UQA_","_USA_")" D TXT^cAFA1(250) D RESET G 2 33 S UREFS=$$UREFS(DMS) I '$D(@UREFS)!'$D(@UREFS@(0)) S K=$P($T(@("T4"_QT)),U,2) D TXT^cAFA1(250) D RESET G 2 35 W /CUP(6,3),$P($$S1(5,2),D)," :",@F92,DMS,@F93,@F1 37 D DMS^cAN000("UQC","USC",DMS) 39 I '$L(UQC) S K=$P($T(@("T6"_QT)),U,2) D TXT^cAFA1(250) D RESET G 2 4 ; W /CUP(7,3),$P($$S1(5,3),D)," :",@F92,UQC,@F93,@F1 41 I '$L(USC) S K=$P($T(@("T7"_QT)),U,2) D TXT^cAFA1(250) D RESET G 2 43 W /CUP(8,3),$P($$S1(5,4),D)," :",@F92,USC,@F93,@F1 45 S UREFC="^DMC(UQC,USC)" 47 I '$D(@UREFC) S K=$P($T(@("T13"_QT)),U,2) D TXT^cAFA1(250) D RESET G 2 ; 5 ; invullen gegevens voor CDL-file : algemene gegevens van de klasse (uit DMS) S SWNVRAAG=1 W /CUP(10,2),@F2,@F6,$P($T(@("T23"_QT)),U,2),@F9,":" 53 S KLNAAM=$$KLNAAM(UREFS,SWNVRAAG) 55 S SQLNAAM=$$SQLNAAM(UREFS,SWNVRAAG) 57 S KLTYPE=$$KLTYPE(UREFS,SWNVRAAG) 6 S KLOMS=$$KLOMS(UREFS,SWNVRAAG) ; 63 D KLPARS(UREFS) I K="-"!(K=",") G YZ 64 D CONF(UREFS) I K="-" G 63 ; 65 D ALG ; algemene gegevens wegschrijven ; 7 D ATTR(UREFA,UQA,USA) ; attributen ophalen via ^DMA 71 D INDEX(UREFC,UQA,USA) ; indexen ophalen via ^DMC ; ; CDL-file aanmaken 8 D ^cABCDL1 G 63:K="-" ; YZ K ^TEMP(boot,$J+.888) D C^cA612 Q ; R0 S $P(R,D,12)=$T(+0) D ^cAN1000 Q ; v12 23.01.95 ; ; enkele algemene gegevens ophalen en wegschrijven ALG N GLOBAL,I1,INDEX,INDEXEN,INDEXNODE,KVNR,TEMP S $ZT="TRAP^cAN000" S KVNR=1 S $P(^TEMP(boot,$J+.888,"KLASSE","ALG"),D,4)="DataM" S $P(^TEMP(boot,$J+.888,"KLASSE","ALG"),D,5)="%CacheSQLStorage;" S TEMP=@UREFC@("DATA","REF") S GLOBAL=$$GLOBAL(TEMP),INDEXNODE=$P(GLOBAL,D,2),GLOBAL=$P(GLOBAL,D) ; dataglobal K ^TEMP(boot,$J+.888,"KLASSE","STOR") S INDEXEN="" F I1=1:1:30 D . S INDEX=$P(INDEXNODE,",",I1) . Q:INDEX="" . S:INDEX="Q" INDEX="""EA""" . S:(INDEX'["""")&(INDEX'?.N) INDEX="{Key"_KVNR_"}",$P(^TEMP(boot,$J+.888,"KLASSE","STOR"),D,3)=$P($G(^TEMP(boot,$J+.888,"KLASSE","STOR")),D,3)_"Key"_KVNR,KVNR=KVNR+1 . S INDEXEN=INDEXEN_INDEX_U S $P(^TEMP(boot,$J+.888,"KLASSE","STOR"),D)=GLOBAL S $P(^TEMP(boot,$J+.888,"KLASSE","STOR"),D,2)=INDEXEN ; K ^TEMP(boot,$J+.888,"KLASSE","STORI") S TEMP=@UREFC@("DATA","INDEX") S GLOBAL=$$GLOBAL(TEMP),INDEXNODE=$P(GLOBAL,D,2),GLOBAL=$P(GLOBAL,D) ; indexglobal S INDEXEN="" F I1=1:1:30 D . S INDEX=$P(INDEXNODE,",",I1) . Q:INDEX="" . S:INDEX="Q" INDEX="""EA""" . S:(INDEX'["""")&(INDEX'?.N) INDEX="{Key"_KVNR_"}",$P(^TEMP(boot,$J+.888,"KLASSE","STORI"),D,3)=$P($G(^TEMP(boot,$J+.888,"KLASSE","STORI")),D,3)_"Key"_KVNR,KVNR=KVNR+1 . S INDEXEN=INDEXEN_INDEX_U S $P(^TEMP(boot,$J+.888,"KLASSE","STORI"),D)=GLOBAL S $P(^TEMP(boot,$J+.888,"KLASSE","STORI"),D,2)=INDEXEN ALGZ Q ; attributen ophalen via ^DMA : ; alle gegevens van een property ophalen via ^DMA ; output : (1) naam \ (2) omschrijving \ (3) type \ (4) verplicht \ (5) uniek \ (6) min lengte \ (7) max lengte ... ; ... \ (8) IDKey ("" = neen) \ (9) attributes \ (10) B-index \ (11) INDEX ("" = neen) ... ; ... \ (12) berekend veld (1 = ja; dan is veld B-index = "") ... ; ... \ (13) expressie voor berekend veld (SQL) \ (14) alternatieve SQL-naam ATTR(UREFA,UQA,USA) N OUT,PAG,RUBR S $ZT="TRAP^cAN000" ; W !!,$P($T(@("T17"_QT)),U,2) S PAG=0 F S PAG=$O(@UREFA@(PAG)) Q:PAG="" D . ; W !," ",PAG . S RUBR=0 F S RUBR=$O(@UREFA@(PAG,RUBR)) Q:RUBR="" D .. S NAAM=$$PNAAM(UQA,USA,PAG,RUBR) ; naam vd property .. Q:'$L(NAAM) .. S OMS=$$POMS(UQA,USA,PAG,RUBR) ; omschrijving vd property .. S TYPE=$$PTYPE(UQA,USA,PAG,RUBR) ; type van de property .. S OUT=NAAM_D_OMS_D_TYPE .. S OUT=OUT_D_$G(^DMA(UQA,USA,PAG,RUBR,34)) ; verplicht .. S OUT=OUT_D_$G(^DMA(UQA,USA,PAG,RUBR,35)) ; uniek .. S OUT=OUT_D_$G(^DMA(UQA,USA,PAG,RUBR,36)) ; min. lengte .. S OUT=OUT_D_$G(^DMA(UQA,USA,PAG,RUBR,37)) ; max. lengte .. S OUT=OUT_D ; IDKey = "" .. S OUT=OUT_D_NAAM ; attribuut (enkel interessant indien INDEX) .. S $P(OUT,D,12)=$G(^DMA(UQA,USA,PAG,RUBR,40)) ; berekend veld (1 = ja) .. I $P(OUT,D,12) S $P(OUT,D,2)="berekend veld" .. I $L($G(^DMA(UQA,USA,PAG,RUBR,38))) S $P(OUT,D,14)=$$FORMAT(^DMA(UQA,USA,PAG,RUBR,38)) ; alt. SQL .. I $P(OUT,D,12) D ... D METHOD(NAAM,$G(^DMA(UQA,USA,PAG,RUBR,41),""""""),TYPE) ; object methode opzetten in ^TEMP ... I $L($G(^DMA(UQA,USA,PAG,RUBR,39))) D ; enkel SQL-berekend veld als gewoon berekend veld .... S $P(OUT,D,13)=^DMA(UQA,USA,PAG,RUBR,39) .. ; .. I $L($G(^DMA(UQA,USA,PAG,RUBR,16))) D ... S $P(OUT,D,10)=$G(^DMA(UQA,USA,PAG,RUBR,16)) ; B-index .. I $G(^DMA(UQA,USA,PAG,RUBR,35)) S $P(OUT,D,11)=1 ; indien uniek : index opzetten .. ; W !," ",$P(OUT,D) .. I $L(OUT) S ^TEMP(boot,$J+.888,"ATTR",$P(OUT,D))=OUT ; attributen wegschrijven ; ; nu gaan bepalen hoeveel Keys er zijn - er is steeds een Key1 S ^TEMP(boot,$J+.888,"ATTR","Key1")="Key1" ATTRZ Q ; ; Naam in juiste formaat zetten FORMAT(STRING) I '$L($G(STRING)) S STRING="" S STRING=$$DP^cAFA1(STRING) FORMATA I $E(STRING)?1N S STRING=$E(STRING,2,$L(STRING)) G FORMATA S $E(STRING)=$$UC^cAFA1($E(STRING)) FORMATZ Q STRING ; ; uit een string het global - en inhoudsgedeelte gaan halen ; input : ^DATA(Q,"EA","PR.HG",UI1 ; output : DATA \ Q,"EA","PR.HG,UI1 GLOBAL(STRING) N GLOBAL I STRING["@(""^""_Q_""" S STRING="^EA"_$P($P(STRING,"@(""^""_Q_""",2),")") S GLOBAL=$P(STRING,"(") S STRING=$P($P(STRING,"(",2),")") GLOBALZ Q GLOBAL_D_STRING ; ;indexen ophalen via ^DMC INDEX(UREFC,UQA,USA) N INAAM,I1,EXIT,KEYATT S $ZT="TRAP^cAN000" ; W !!,$P($T(@("T14"_QT)),U,2) S I1=0 F S I1=$O(@UREFC@("INDEX",I1)) Q:I1="" D . S BINDEX=$G(^(I1)) Q:'$L(BINDEX) . S EXIT=0 . S ATTR=0 F S ATTR=$O(^TEMP(boot,$J+.888,"ATTR",ATTR)) Q:ATTR=""!EXIT D .. S NODE=^(ATTR) .. I $P(NODE,D,10)=BINDEX D ... S $P(NODE,D,11)=1,^TEMP(boot,$J+.888,"ATTR",ATTR)=NODE,EXIT=1 ; het is een INDEX ... ; W !," ",$P(NODE,D) ; ; dan nog de UniqueKey1Index toevoegen S KEYATT=$S($L($P($G(^TEMP(boot,$J+.888,"KLASSE","STOR")),D,3)):$P($G(^TEMP(boot,$J+.888,"KLASSE","STOR")),D,3),1:"Key1") S ^TEMP(boot,$J+.888,"ATTR","Key1")="Key1\"_$P($T(@("T16"_QT)),U,2)_"\"_$P($T(@("T15"_QT)),U,2)_"\1\1\\\1\"_KEYATT_"\\1" ; W !," UniqueKey1" INDEXZ Q ; METHOD(NAAM,EXPRESSI,TYPE) S ^TEMP(boot,$J+.888,"METHOD",NAAM)=NAAM_"Get"_D_TYPE_D_0_D_"not final"_D_1_D_0_D_EXPRESSION ; naam \ type \ classmethod \ (not) final \ public ( = 0) \ sqlproc \ expression METHODZ Q ; ; naam van een property ophalen via ^DMA PNAAM(UQA,USA,PAG,RUBR) N OUT S $ZT="TRAP^cAN000" S OUT=$G(^DMA(UQA,USA,PAG,RUBR,31)) I '$L(OUT) S OUT=$P($G(^DMA(UQA,USA,PAG,RUBR,1)),D) S OUT=$$FORMAT(OUT) PNAAMZ Q OUT ; ; omschrijving van een property ophalen via ^DMA POMS(UQA,USA,PAG,RUBR) N OUT S $ZT="TRAP^cAN000" S OUT=$G(^DMA(UQA,USA,PAG,RUBR,32)) I '$L($G(OUT)) D . S OUT=$P($G(^DMA(UQA,USA,PAG,RUBR,1)),D) . S OUT=OUT_$S($L($P($G(^DMA(UQA,USA,PAG,RUBR,10)),D)):" ("_$P($G(^DMA(UQA,USA,PAG,RUBR,10)),D)_")",1:"") POMSZ Q OUT ; ; type van een property ophalen via ^DMA PTYPE(UQA,USA,PAG,RUBR) N OUT S $ZT="TRAP^cAN000" S OUT=$G(^DMA(UQA,USA,PAG,RUBR,33)) I "01234"[OUT S OUT=$P($T(@("T15"_QT)),U,2+OUT) G PTYPEZ I OUT=5 D ; klasse via utili . N UREFS,DMS . S DMS=$G(^DMA(UQA,USA,PAG,RUBR,18)) . S UREFS=$$UREFS^cABCDL(DMS) . S OUT=$$KLNAAM(UREFS,1) PTYPEZ Q OUT ; ; naam van de klasse ophalen via ^DMS KLNAAM(UREFS,SW) N OUT S $ZT="TRAP^cAN000" S OUT=$P($G(^TEMP(boot,$J+.888,"KLASSE","ALG")),D) I '$L(OUT) S OUT=$P(@UREFS@(0),D,12) I '$G(SW)!(OUT="") S R="OUT\22\3\"_$P($T(@("T8"_QT)),U,2)_"\30\\K?1U.AN!(K=""-"")\\\\\1" D R0 I K="-" G KLNAAMZ S $P(^TEMP(boot,$J+.888,"KLASSE","ALG"),D)=OUT W /CUP(11,3),@F2,1,@F6,$P($T(@("T9"_QT)),U,2),@F9,/CUP(11,17)," : ",OUT KLNAAMZ Q OUT ; ; SQL-naam van de klasse ophalen via ^DMS SQLNAAM(UREFS,SW) N OUT S $ZT="TRAP^cAN000" S OUT=$P($G(^TEMP(boot,$J+.888,"KLASSE","ALG")),D,6) I '$L(OUT) S OUT=$P(@UREFS@(0),D,13) I '$G(SW) S R="OUT\22\3\"_$P($T(@("T20"_QT)),U,2)_"\30\\K?1A.AN!(""-""[K)\\\\\1" D R0 I K="-" G SQLNAAMZ S $P(^TEMP(boot,$J+.888,"KLASSE","ALG"),D,6)=OUT W /CUP(12,3),@F2,2,@F6,$P($T(@("T21"_QT)),U,2),@F9,/CUP(12,17)," : ",OUT SQLNAAMZ Q OUT ; ; omschrijving van de klasse ophalen via ^DMS KLOMS(UREFS,SW) N OUT S $ZT="TRAP^cAN000" S OUT=$P($G(^TEMP(boot,$J+.888,"KLASSE","ALG")),D,3) I '$L(OUT) S OUT=$P(@UREFS@(0),D,14) I '$G(SW) S R="OUT\22\3\"_$P($T(@("T18"_QT)),U,2)_"\30\\\\\\\1" D R0 I K="-" G KLOMSZ S $P(^TEMP(boot,$J+.888,"KLASSE","ALG"),D,3)=OUT W /CUP(14,3),@F2,4,@F6,$P($T(@("T12"_QT)),U,2),@F9,/CUP(14,17)," : ",OUT KLOMSZ Q OUT ; ; type van de klasse : voorlopig steeds %Persistent KLTYPE(UREFS,SW) N OUT S $ZT="TRAP^cAN000" S OUT=$P($T(@("T19"_QT)),U,2) S $ZT="TRAP^cAN000" S OUT=$P($P($G(^TEMP(boot,$J+.888,"KLASSE","ALG")),D,2),U) I '$L(OUT) S OUT=$P(@UREFS@(0),D,15) I '$G(SW) S R="OUT\22\3\"_$P($T(@("T19"_QT)),U,2)_"\1\\""1234-""[K\\\\\1" D R0 I K="-" G KLTYPEZ S $P(^TEMP(boot,$J+.888,"KLASSE","ALG"),D,2)=OUT_U_$P($T(T10),U,OUT+2) W /CUP(13,3),@F2,3,@F6,$P($T(@("T11"_QT)),U,2),@F9,/CUP(13,17)," : ",$P($T(T10),U,OUT+2) KLTYPEZ Q OUT ; ; bevestiging vragen van de klasseparameters KLPARS(UREFS) KLPARSA S R="K\22\3\"_$P($T(@("T22"_QT)),U,2)_"\2\\""1234-,""[K\\\\\" D R0 G:"0-,"[K KLPARSZ D . I K=1 S K=$$KLNAAM(UREFS,0) Q . I K=2 S K=$$SQLNAAM(UREFS,0) Q . I K=3 S K=$$KLTYPE(UREFS,0) Q . I K=4 S K=$$KLOMS(UREFS,0) Q G KLPARSA KLPARSZ Q ; ; indien wijzigingen aangebracht aan klasseparameters: eventueel wegschrijven naar ^DMS CONF(UREFS) N SW S SW=0,K="" S $ZT="TRAP^cAN000" I $P(^TEMP(boot,$J+.888,"KLASSE","ALG"),D)'=$P(@UREFS@(0),D,12) S SW=1 I $P($P(^TEMP(boot,$J+.888,"KLASSE","ALG"),D,2),U)'=$P(@UREFS@(0),D,15) S SW=1 I $P(^TEMP(boot,$J+.888,"KLASSE","ALG"),D,3)'=$P(@UREFS@(0),D,14) S SW=1 I $P(^TEMP(boot,$J+.888,"KLASSE","ALG"),D,6)'=$P(@UREFS@(0),D,13) S SW=1 I SW S R="K\22\3\"_$P($T(@("T24"_QT)),U,2)_"\1\\""01-""[K\\\\\" D R0 G:"0-"[K CONFZ D . S $P(@UREFS@(0),D,12)=$P(^TEMP(boot,$J+.888,"KLASSE","ALG"),D) . S $P(@UREFS@(0),D,15)=$P($P(^TEMP(boot,$J+.888,"KLASSE","ALG"),D,2),U) . S $P(@UREFS@(0),D,14)=$P(^TEMP(boot,$J+.888,"KLASSE","ALG"),D,3) . S $P(@UREFS@(0),D,13)=$P(^TEMP(boot,$J+.888,"KLASSE","ALG"),D,6) CONFZ Q ; RESET S UQA="",USA="" RESETZ Q ; S1(T,P) N R S R=$P($T(@("T"_T)),U,P) S1Z Q R ; UREFS(DMS) N OUT S OUT="" S OUT="^DMS(Q,DMS)" I '$D(@OUT)!'$D(@OUT@(0)) S OUT="^DMS(0,DMS)" UREFSZ Q OUT ; ZZ ; 18.05.01 - 11 u 18 * V7.86