| 1 | GECSXMAP ;WISC/RFJ-build template map                               ;01 Nov 93 | 
|---|
| 2 | ;;2.0;GCS;;MAR 14, 1995 | 
|---|
| 3 | W !,"This program deletes template maps and recreates them",!,"from the input templates found in file 2101.4.",! | 
|---|
| 4 | N %,GECSITDA | 
|---|
| 5 | S XP="Do you want to recreate all template maps" | 
|---|
| 6 | S %=$$YN^GECSUTIL(2) I '% Q | 
|---|
| 7 | I %=1 D ALLMAPS Q | 
|---|
| 8 | ;  ask template, build map | 
|---|
| 9 | F  S GECSITDA=$$SELTEMP Q:'GECSITDA  D BUILD(GECSITDA) | 
|---|
| 10 | Q | 
|---|
| 11 | ; | 
|---|
| 12 | ; | 
|---|
| 13 | ALLMAPS ;  build all maps | 
|---|
| 14 | N DIC,GECSITDA,X,Y | 
|---|
| 15 | S GECSITDA=0 F  S GECSITDA=$O(^GECS(2101.4,GECSITDA)) Q:'GECSITDA  D | 
|---|
| 16 | .   S X=$P(^GECS(2101.4,GECSITDA,0),"^") | 
|---|
| 17 | .   S DIC=2101.4,DIC(0)="MZ" D ^DIC | 
|---|
| 18 | .   I Y>0 W !,Y(0,0) D BUILD(GECSITDA) | 
|---|
| 19 | Q | 
|---|
| 20 | ; | 
|---|
| 21 | ; | 
|---|
| 22 | BUILD(GECSITDA)      ;  build template gecsitda | 
|---|
| 23 | N %,GECSMAP,GECSNM | 
|---|
| 24 | S GECSNM=$P($G(^GECS(2101.4,GECSITDA,0)),"^") I GECSNM="" W "  INPUT TEMPLATE DOES NOT EXIST IN FILE 2101.4." Q | 
|---|
| 25 | S %=$O(^DIE("B",GECSNM,0)) I '% W "  INPUT TEMPLATE NOT FOUND IN FILEMANAGER." Q | 
|---|
| 26 | D GETMAP(%) I '$D(GECSMAP) Q | 
|---|
| 27 | K ^GECS(2101.4,GECSITDA,1) F %=1:1 Q:'$D(GECSMAP(%))  S ^GECS(2101.4,GECSITDA,1,%,0)=GECSMAP(%) | 
|---|
| 28 | S ^GECS(2101.4,GECSITDA,1,0)="^2101.41^"_(%-1)_"^"_(%-1) | 
|---|
| 29 | W ?40,"---Done---" | 
|---|
| 30 | Q | 
|---|
| 31 | ; | 
|---|
| 32 | ; | 
|---|
| 33 | FIELD ;  loop fields in dr string | 
|---|
| 34 | N GECSMAP1 | 
|---|
| 35 | F DRPIECE=1:1 S FIELDDA=$P(GECSTRIN,";",DRPIECE) Q:FIELDDA=""  I +FIELDDA>0,$D(^DD(2100,+FIELDDA,0)) S DATADICT=^(0) D | 
|---|
| 36 | .   ;  single field | 
|---|
| 37 | .   I $P(DATADICT,"^",2)?1A.E D  Q | 
|---|
| 38 | .   .   S GECSMAP(GECSMAP)=GECSMAP(GECSMAP)_+FIELDDA_";"_$P(DATADICT,"^",4)_"\" | 
|---|
| 39 | .   .   I $L(GECSMAP(GECSMAP))>200 S GECSMAP=GECSMAP+1,GECSMAP(GECSMAP)="" | 
|---|
| 40 | .   ;  multiple field | 
|---|
| 41 | .   I GECSMAP(GECSMAP)'="" S GECSMAP=GECSMAP+1,GECSMAP(GECSMAP)="" | 
|---|
| 42 | .   S (GECSGLOB,GECSMAP(GECSMAP))=FIELDDA_","_$P($P(DATADICT,"^",4),";")_","_+$P(DATADICT,"^",2) | 
|---|
| 43 | .   S GECSTR=DRSTRING(2,+$P(DATADICT,"^",2)) | 
|---|
| 44 | .   S GECSNEXT=1,GECSPIEC=1,GECSMAP1=1 | 
|---|
| 45 | .   F  D  Q:'GECSPIEC | 
|---|
| 46 | .   .   S FIELDDA=$P(GECSTR,";",GECSPIEC),GECSPIEC=GECSPIEC+1 | 
|---|
| 47 | .   .   I +FIELDDA>0,$D(^DD(+$P(DATADICT,"^",2),+FIELDDA,0)) S GECSMAP(GECSMAP,GECSMAP1)=$G(GECSMAP(GECSMAP,GECSMAP1))_+FIELDDA_";"_$P(^(0),"^",4)_"\" | 
|---|
| 48 | .   .   I $P(GECSTR,";",GECSPIEC)="" S GECSTR=$G(DRSTRING(2,+$P(DATADICT,"^",2),GECSNEXT)),GECSNEXT=GECSNEXT+1,GECSPIEC=1 I GECSTR="" S GECSPIEC=0 Q | 
|---|
| 49 | .   .   I $L(GECSMAP(GECSMAP,GECSMAP1))>200 S GECSMAP1=GECSMAP1+1 | 
|---|
| 50 | .    S GECSMAP=GECSMAP+1,GECSMAP(GECSMAP)="" | 
|---|
| 51 | Q | 
|---|
| 52 | ; | 
|---|
| 53 | ; | 
|---|
| 54 | GETMAP(GECSDIE) ;  get the template map for input template gecsdie | 
|---|
| 55 | ;  returns gecsmap() array | 
|---|
| 56 | N DATADICT,DRPIECE,DRSTRING,FIELDDA,GECSDRDA,GECSGLOB,GECSNEXT,GECSPIEC,GECSTRIN,GECSTR,I,J,K,X | 
|---|
| 57 | K GECSMAP | 
|---|
| 58 | I '$D(^DIE(GECSDIE)) Q | 
|---|
| 59 | F I=0:0 S I=$O(^DIE(GECSDIE,"DR",I)) Q:I=""  F J=0:0 S J=$O(^DIE(GECSDIE,"DR",I,J)) Q:J=""  S DRSTRING(I,J)=^DIE(GECSDIE,"DR",I,J) F K=0:0 S K=$O(^DIE(GECSDIE,"DR",I,J,K)) Q:'K  S DRSTRING(I,J,K)=^(K) | 
|---|
| 60 | I '$D(DRSTRING(1,2100)) W "   NOT AN INPUT TEMPLATE FOR FILE 2100!  MAP NOT BUILT!",! Q | 
|---|
| 61 | S GECSMAP=1,GECSMAP(1)="" | 
|---|
| 62 | S GECSTRIN=DRSTRING(1,2100) D FIELD | 
|---|
| 63 | S GECSDRDA=0 F  S GECSDRDA=$O(DRSTRING(1,2100,GECSDRDA)) Q:'GECSDRDA  S GECSTRIN=DRSTRING(1,2100,GECSDRDA) D FIELD | 
|---|
| 64 | Q | 
|---|
| 65 | ; | 
|---|
| 66 | ; | 
|---|
| 67 | SELTEMP() ;  select template | 
|---|
| 68 | N %,%Y,DA,DIC,DLAYGO,X,Y | 
|---|
| 69 | S DIC("A")="Select Template Name: ",DIC=2101.4,DIC(0)="LAEMNZ",DLAYGO=2101.4 | 
|---|
| 70 | W ! D ^DIC | 
|---|
| 71 | Q $S(+Y>0:+Y,1:0) | 
|---|