source: WorldVistAEHR/trunk/r/GENERIC_CODE_SHEET-GEC/GECSXMAP.m@ 1739

Last change on this file since 1739 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.1 KB
RevLine 
[613]1GECSXMAP ;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 ;
13ALLMAPS ; 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 ;
22BUILD(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 ;
33FIELD ; 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 ;
54GETMAP(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 ;
67SELTEMP() ; 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)
Note: See TracBrowser for help on using the repository browser.