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 Dec 13, 2024@01:56:46 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)
