- GECSXMAP ;WISC/RFJ-build template map ;01 Nov 93
- ;;2.0;GCS;;MAR 14, 1995
- W !,"This program deletes template maps and recreates them",!,"from the input templates found in file 2101.4.",!
- N %,GECSITDA
- S XP="Do you want to recreate all template maps"
- S %=$$YN^GECSUTIL(2) I '% Q
- I %=1 D ALLMAPS Q
- ; ask template, build map
- F S GECSITDA=$$SELTEMP Q:'GECSITDA D BUILD(GECSITDA)
- Q
- ;
- ;
- ALLMAPS ; build all maps
- N DIC,GECSITDA,X,Y
- S GECSITDA=0 F S GECSITDA=$O(^GECS(2101.4,GECSITDA)) Q:'GECSITDA D
- . S X=$P(^GECS(2101.4,GECSITDA,0),"^")
- . S DIC=2101.4,DIC(0)="MZ" D ^DIC
- . I Y>0 W !,Y(0,0) D BUILD(GECSITDA)
- Q
- ;
- ;
- BUILD(GECSITDA) ; build template gecsitda
- N %,GECSMAP,GECSNM
- S GECSNM=$P($G(^GECS(2101.4,GECSITDA,0)),"^") I GECSNM="" W " INPUT TEMPLATE DOES NOT EXIST IN FILE 2101.4." Q
- S %=$O(^DIE("B",GECSNM,0)) I '% W " INPUT TEMPLATE NOT FOUND IN FILEMANAGER." Q
- D GETMAP(%) I '$D(GECSMAP) Q
- K ^GECS(2101.4,GECSITDA,1) F %=1:1 Q:'$D(GECSMAP(%)) S ^GECS(2101.4,GECSITDA,1,%,0)=GECSMAP(%)
- S ^GECS(2101.4,GECSITDA,1,0)="^2101.41^"_(%-1)_"^"_(%-1)
- W ?40,"---Done---"
- Q
- ;
- ;
- FIELD ; loop fields in dr string
- N GECSMAP1
- F DRPIECE=1:1 S FIELDDA=$P(GECSTRIN,";",DRPIECE) Q:FIELDDA="" I +FIELDDA>0,$D(^DD(2100,+FIELDDA,0)) S DATADICT=^(0) D
- . ; single field
- . I $P(DATADICT,"^",2)?1A.E D Q
- . . S GECSMAP(GECSMAP)=GECSMAP(GECSMAP)_+FIELDDA_";"_$P(DATADICT,"^",4)_"\"
- . . I $L(GECSMAP(GECSMAP))>200 S GECSMAP=GECSMAP+1,GECSMAP(GECSMAP)=""
- . ; multiple field
- . I GECSMAP(GECSMAP)'="" S GECSMAP=GECSMAP+1,GECSMAP(GECSMAP)=""
- . S (GECSGLOB,GECSMAP(GECSMAP))=FIELDDA_","_$P($P(DATADICT,"^",4),";")_","_+$P(DATADICT,"^",2)
- . S GECSTR=DRSTRING(2,+$P(DATADICT,"^",2))
- . S GECSNEXT=1,GECSPIEC=1,GECSMAP1=1
- . F D Q:'GECSPIEC
- . . S FIELDDA=$P(GECSTR,";",GECSPIEC),GECSPIEC=GECSPIEC+1
- . . I +FIELDDA>0,$D(^DD(+$P(DATADICT,"^",2),+FIELDDA,0)) S GECSMAP(GECSMAP,GECSMAP1)=$G(GECSMAP(GECSMAP,GECSMAP1))_+FIELDDA_";"_$P(^(0),"^",4)_"\"
- . . I $P(GECSTR,";",GECSPIEC)="" S GECSTR=$G(DRSTRING(2,+$P(DATADICT,"^",2),GECSNEXT)),GECSNEXT=GECSNEXT+1,GECSPIEC=1 I GECSTR="" S GECSPIEC=0 Q
- . . I $L(GECSMAP(GECSMAP,GECSMAP1))>200 S GECSMAP1=GECSMAP1+1
- . S GECSMAP=GECSMAP+1,GECSMAP(GECSMAP)=""
- Q
- ;
- ;
- GETMAP(GECSDIE) ; get the template map for input template gecsdie
- ; returns gecsmap() array
- N DATADICT,DRPIECE,DRSTRING,FIELDDA,GECSDRDA,GECSGLOB,GECSNEXT,GECSPIEC,GECSTRIN,GECSTR,I,J,K,X
- K GECSMAP
- I '$D(^DIE(GECSDIE)) Q
- 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)
- I '$D(DRSTRING(1,2100)) W " NOT AN INPUT TEMPLATE FOR FILE 2100! MAP NOT BUILT!",! Q
- S GECSMAP=1,GECSMAP(1)=""
- S GECSTRIN=DRSTRING(1,2100) D FIELD
- S GECSDRDA=0 F S GECSDRDA=$O(DRSTRING(1,2100,GECSDRDA)) Q:'GECSDRDA S GECSTRIN=DRSTRING(1,2100,GECSDRDA) D FIELD
- Q
- ;
- ;
- SELTEMP() ; select template
- N %,%Y,DA,DIC,DLAYGO,X,Y
- S DIC("A")="Select Template Name: ",DIC=2101.4,DIC(0)="LAEMNZ",DLAYGO=2101.4
- W ! D ^DIC
- Q $S(+Y>0:+Y,1:0)
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGECSXMAP 3251 printed Jan 18, 2025@02:57:58 Page 2
- GECSXMAP ;WISC/RFJ-build template map ;01 Nov 93
- +1 ;;2.0;GCS;;MAR 14, 1995
- +2 WRITE !,"This program deletes template maps and recreates them",!,"from the input templates found in file 2101.4.",!
- +3 NEW %,GECSITDA
- +4 SET XP="Do you want to recreate all template maps"
- +5 SET %=$$YN^GECSUTIL(2)
- IF '%
- QUIT
- +6 IF %=1
- DO ALLMAPS
- QUIT
- +7 ; ask template, build map
- +8 FOR
- SET GECSITDA=$$SELTEMP
- if 'GECSITDA
- QUIT
- DO BUILD(GECSITDA)
- +9 QUIT
- +10 ;
- +11 ;
- ALLMAPS ; build all maps
- +1 NEW DIC,GECSITDA,X,Y
- +2 SET GECSITDA=0
- FOR
- SET GECSITDA=$ORDER(^GECS(2101.4,GECSITDA))
- if 'GECSITDA
- QUIT
- Begin DoDot:1
- +3 SET X=$PIECE(^GECS(2101.4,GECSITDA,0),"^")
- +4 SET DIC=2101.4
- SET DIC(0)="MZ"
- DO ^DIC
- +5 IF Y>0
- WRITE !,Y(0,0)
- DO BUILD(GECSITDA)
- End DoDot:1
- +6 QUIT
- +7 ;
- +8 ;
- BUILD(GECSITDA) ; build template gecsitda
- +1 NEW %,GECSMAP,GECSNM
- +2 SET GECSNM=$PIECE($GET(^GECS(2101.4,GECSITDA,0)),"^")
- IF GECSNM=""
- WRITE " INPUT TEMPLATE DOES NOT EXIST IN FILE 2101.4."
- QUIT
- +3 SET %=$ORDER(^DIE("B",GECSNM,0))
- IF '%
- WRITE " INPUT TEMPLATE NOT FOUND IN FILEMANAGER."
- QUIT
- +4 DO GETMAP(%)
- IF '$DATA(GECSMAP)
- QUIT
- +5 KILL ^GECS(2101.4,GECSITDA,1)
- FOR %=1:1
- if '$DATA(GECSMAP(%))
- QUIT
- SET ^GECS(2101.4,GECSITDA,1,%,0)=GECSMAP(%)
- +6 SET ^GECS(2101.4,GECSITDA,1,0)="^2101.41^"_(%-1)_"^"_(%-1)
- +7 WRITE ?40,"---Done---"
- +8 QUIT
- +9 ;
- +10 ;
- FIELD ; loop fields in dr string
- +1 NEW GECSMAP1
- +2 FOR DRPIECE=1:1
- SET FIELDDA=$PIECE(GECSTRIN,";",DRPIECE)
- if FIELDDA=""
- QUIT
- IF +FIELDDA>0
- IF $DATA(^DD(2100,+FIELDDA,0))
- SET DATADICT=^(0)
- Begin DoDot:1
- +3 ; single field
- +4 IF $PIECE(DATADICT,"^",2)?1A.E
- Begin DoDot:2
- +5 SET GECSMAP(GECSMAP)=GECSMAP(GECSMAP)_+FIELDDA_";"_$PIECE(DATADICT,"^",4)_"\"
- +6 IF $LENGTH(GECSMAP(GECSMAP))>200
- SET GECSMAP=GECSMAP+1
- SET GECSMAP(GECSMAP)=""
- End DoDot:2
- QUIT
- +7 ; multiple field
- +8 IF GECSMAP(GECSMAP)'=""
- SET GECSMAP=GECSMAP+1
- SET GECSMAP(GECSMAP)=""
- +9 SET (GECSGLOB,GECSMAP(GECSMAP))=FIELDDA_","_$PIECE($PIECE(DATADICT,"^",4),";")_","_+$PIECE(DATADICT,"^",2)
- +10 SET GECSTR=DRSTRING(2,+$PIECE(DATADICT,"^",2))
- +11 SET GECSNEXT=1
- SET GECSPIEC=1
- SET GECSMAP1=1
- +12 FOR
- Begin DoDot:2
- +13 SET FIELDDA=$PIECE(GECSTR,";",GECSPIEC)
- SET GECSPIEC=GECSPIEC+1
- +14 IF +FIELDDA>0
- IF $DATA(^DD(+$PIECE(DATADICT,"^",2),+FIELDDA,0))
- SET GECSMAP(GECSMAP,GECSMAP1)=$GET(GECSMAP(GECSMAP,GECSMAP1))_+FIELDDA_";"_$PIECE(^(0),"^",4)_"\"
- +15 IF $PIECE(GECSTR,";",GECSPIEC)=""
- SET GECSTR=$GET(DRSTRING(2,+$PIECE(DATADICT,"^",2),GECSNEXT))
- SET GECSNEXT=GECSNEXT+1
- SET GECSPIEC=1
- IF GECSTR=""
- SET GECSPIEC=0
- QUIT
- +16 IF $LENGTH(GECSMAP(GECSMAP,GECSMAP1))>200
- SET GECSMAP1=GECSMAP1+1
- End DoDot:2
- if 'GECSPIEC
- QUIT
- +17 SET GECSMAP=GECSMAP+1
- SET GECSMAP(GECSMAP)=""
- End DoDot:1
- +18 QUIT
- +19 ;
- +20 ;
- GETMAP(GECSDIE) ; get the template map for input template gecsdie
- +1 ; returns gecsmap() array
- +2 NEW DATADICT,DRPIECE,DRSTRING,FIELDDA,GECSDRDA,GECSGLOB,GECSNEXT,GECSPIEC,GECSTRIN,GECSTR,I,J,K,X
- +3 KILL GECSMAP
- +4 IF '$DATA(^DIE(GECSDIE))
- QUIT
- +5 FOR I=0:0
- SET I=$ORDER(^DIE(GECSDIE,"DR",I))
- if I=""
- QUIT
- FOR J=0:0
- SET J=$ORDER(^DIE(GECSDIE,"DR",I,J))
- if J=""
- QUIT
- SET DRSTRING(I,J)=^DIE(GECSDIE,"DR",I,J)
- FOR K=0:0
- SET K=$ORDER(^DIE(GECSDIE,"DR",I,J,K))
- if 'K
- QUIT
- SET DRSTRING(I,J,K)=^(K)
- +6 IF '$DATA(DRSTRING(1,2100))
- WRITE " NOT AN INPUT TEMPLATE FOR FILE 2100! MAP NOT BUILT!",!
- QUIT
- +7 SET GECSMAP=1
- SET GECSMAP(1)=""
- +8 SET GECSTRIN=DRSTRING(1,2100)
- DO FIELD
- +9 SET GECSDRDA=0
- FOR
- SET GECSDRDA=$ORDER(DRSTRING(1,2100,GECSDRDA))
- if 'GECSDRDA
- QUIT
- SET GECSTRIN=DRSTRING(1,2100,GECSDRDA)
- DO FIELD
- +10 QUIT
- +11 ;
- +12 ;
- SELTEMP() ; select template
- +1 NEW %,%Y,DA,DIC,DLAYGO,X,Y
- +2 SET DIC("A")="Select Template Name: "
- SET DIC=2101.4
- SET DIC(0)="LAEMNZ"
- SET DLAYGO=2101.4
- +3 WRITE !
- DO ^DIC
- +4 QUIT $SELECT(+Y>0:+Y,1:0)