GMRGTGI2.m

GMRGTGI2 ;CISC/RM,RTK-PRIME DOCUMENT EDIT (cont.) ;8/23/93

 ;;3.0;Text Generator;;Jan 24, 1996

EN1 ; ENTRY FROM CHOOSING WHETHER TO EDIT THE TERM, EDIT THE SELECTION

 ; ADD A SELECTION OR DELETE A SELECTION.

 ; Y=$S(#:EDIT SEL.,"T"!"t":EDIT TERM,"A"!"a":ADD,#_@:DELETE)

 I 'GMRGINFO("SEL"),Y?1N.N0.1"@" W !,$C(7),"NO SELECTIONS!!" Q

 I Y?1N.N0.1"@"!(Y?1N.N1"D")!(Y?1N.N1"d") I +Y<1!(+Y>GMRGINFO("SEL")) W !?3,$C(7),"CHOOSE A NUMBER IN THE SELECTION LIST ABOVE PLEASE" Q

 G TERM:"Tt"[Y,ADD:"Aa"[Y,DELETE:Y?1N.N1"@",SEL:Y?1N.N,DISPLAY:Y?1N.N1"D"!(Y?1N.N1"d")

 Q

TERM ; EDIT THE ENTRY

 I $P(GMRGINFO("CLAS"),U,2)="PRIME DOCUMENT" W !,"NAME: ",$P(GMRGINFO("TEXT"),U),"// (UNEDITABLE)"

 E  D  Q:GMRGOUT  I $G(GMRGRASK) K GMRGRASK G TERM

 .  K GMRGRASK W !,"NAME:" S (GMRGTX("@"),GMRGTX(1))=0,GMRGTX(0)=$P(GMRGINFO("TEXT"),"^") D EN1^GMRGED3 S X=$S(GMRGTX(0)'="":GMRGTX(0),1:"@") I GMRGOUT S GMRGOUT=0 Q

 .  I X?1P.E,X'?1"[".E,X'?1"<".E W !?3,$C(7),$S(X="@":"CANNOT DELETE",1:"Answer must free text 3-60 characters") S GMRGRASK=1 Q

 .  I X'=$P(GMRGINFO("TEXT"),"^") S GMRGT=X D CHK^GMRGTGI0 Q:GMRGOUT!GMRGDUP  W !,".changing '",$P(GMRGINFO("TEXT"),"^"),"' to '",GMRGT,"'" S DIE="^GMRD(124.2,",DA=GMRGINFO,DR=".01///^S X=GMRGT" D ^DIE I $S($D(Y):1,1:0) S GMRGRASK=1 Q

 .  Q

 S DA=GMRGINFO,DIE="^GMRD(124.2,",DR="[GMRG EDIT TERM]" D ^DIE K DIC

 S X="`"_DA,DIC=DIE,DIC(0)="Q" D ^DIC I +Y>0 K GMRGINFO S GMRGINFO=+Y D INFOSET^GMRGTGI0

 Q

SEL ; EDIT THE SELETION

 S GMRGSEL=$P(GMRGINFO("SEL",+Y),"^",2) D DOWN^GMRGTGI1 Q:GMRGOUT

B D EN2^GMRGTGIF I GMRGUP D UP^GMRGTGI1 S GMRGUP=0 Q

 G:'GMRGOUT B

 Q

ADD ; ADD SELECTIONS

 I $P(GMRGINFO("TYPE"),"^")=3 W !!?3,$C(7),"You cannot add selections to an aggregate term which is of type 'TERM'"

 I  W !?3,"If you want to add selections for this term, then first edit the TYPE",!?3,"of this term and change it to something other than 'TERM'." Q

 W ! S DX=$X,DY=0 X ^%ZOSF("XY") W !,"Select term to add: " R X:DTIME S:'$T!(X="^")!(X="^^") GMRGOUT=1 Q:X=""!GMRGOUT  S GMRGX=X

 S DIC("S")="I GMRGINFO'=+Y,$P(^(0),U,2)'<$P(GMRGINFO(""TYPE""),U) S GMRGZ=$O(^GMRD(124.2,GMRGINFO,1,""B"",+Y,0)) I $S(GMRGZ'>0:1,'$D(^GMRD(124.2,GMRGINFO,1,GMRGZ,0)):1,'$P(^(0),U,6):0,1:1)",DIC(0)="EN",DIC="^GMRD(124.2," D ^DIC

 K DIC G:X?."?" ADD S I(0)=$L(X) F I=1:1:I(0) Q:$E(X)'=" "  S X=$E(X,2,$L(X))

 I X="" W $C(7),"  ??" G ADD

YNOK I +Y>0 W !,"Is this the entry you want" S %=1 D YN^DICN S:%=2 Y=-1 S:%=-1 GMRGOUT=1 S:%=1 GMRGX=X Q:GMRGOUT  I '% W !?5,"Answer Yes if this is the record you meant to select, else answer No." G YNOK

 I +Y'>0 S DIC("DR")=".02;K DIC(""S"");.03///^S X=GMRGPK",DLAYGO=124.2,DIC(0)="EL",X=""""_GMRGX_"""",DIC="^GMRD(124.2," D ^DIC K DIC,DLAYGO G:+Y'>0 ADD

 W ! S:'$D(^GMRD(124.2,GMRGINFO,1,0)) ^(0)="^124.21PI^^0" W "."

 S GMRGZ=$O(^GMRD(124.2,GMRGINFO,1,"B",+Y,0)),GMRGZ(0)=+Y

 I GMRGZ>0 S DA(1)=GMRGINFO,DA=GMRGZ,DIE="^GMRD(124.2,DA(1),1,",DR="5///^S X=0" D ^DIE

 I GMRGZ'>0 S X=+Y,DIC="^GMRD(124.2,DA(1),1,",(D0,DA(1))=GMRGINFO,DLAYGO=124.21,DIC(0)="LZ" K DD D FILE^DICN K DIC,DLAYGO W "." I +Y'>0 W !?3,$C(7),"Could not add this term to the selection list??" G ADD

 K GMRGINFO S GMRGINFO=DA(1) D INFOSET^GMRGTGI0 W "added"

 Q

DELETE ; DELETE SELECTIONS

 W !,"..." G:$P(GMRGRT(0),"^",3)'=GMRGPK STDLFL

 S DA(1)=GMRGINFO,DIK="^GMRD(124.2,DA(1),1,",DA=$P(GMRGINFO("SEL",+Y),"^") D ^DIK G RSINAR

STDLFL S DA(1)=GMRGINFO,DA=$P(GMRGINFO("SEL",+Y),"^"),DIE="^GMRD(124.2,DA(1),1,",DR="5///^S X=1" D ^DIE

RSINAR W "." K GMRGINFO S GMRGINFO=DA(1) D INFOSET^GMRGTGI0 W "deleted"

 Q

DISPLAY ;

 W !!?3,$P(GMRGINFO("SEL",+Y),"^",3) S DA(1)=GMRGINFO,DA=$P(GMRGINFO("SEL",+Y),"^"),DIE="^GMRD(124.2,DA(1),1,",DR=6_"     DISPLAY ORDER" D ^DIE S:$D(Y) GMRGOUT=1 Q:GMRGOUT

 S Y=GMRGINFO K GMRGINFO S GMRGINFO=+Y D INFOSET^GMRGTGI0

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---GMRGTGI2   3806     printed  Mar 13, 2025@21:00:17                                                                                                                                                                                                    Page 2

GMRGTGI2  ;CISC/RM,RTK-PRIME DOCUMENT EDIT (cont.) ;8/23/93

 +1       ;;3.0;Text Generator;;Jan 24, 1996

EN1       ; ENTRY FROM CHOOSING WHETHER TO EDIT THE TERM, EDIT THE SELECTION

 +1       ; ADD A SELECTION OR DELETE A SELECTION.

 +2       ; Y=$S(#:EDIT SEL.,"T"!"t":EDIT TERM,"A"!"a":ADD,#_@:DELETE)

 +3        IF 'GMRGINFO("SEL")

               IF Y?1N.N0.1"@"

                   WRITE !,$CHAR(7),"NO SELECTIONS!!"

                   QUIT 

 +4        IF Y?1N.N0.1"@"!(Y?1N.N1"D")!(Y?1N.N1"d")

               IF +Y<1!(+Y>GMRGINFO("SEL"))

                   WRITE !?3,$CHAR(7),"CHOOSE A NUMBER IN THE SELECTION LIST ABOVE PLEASE"

                   QUIT 

 +5        if "Tt"[Y

               GOTO TERM

           if "Aa"[Y

               GOTO ADD

           if Y?1N.N1"@"

               GOTO DELETE

           if Y?1N.N

               GOTO SEL

           if Y?1N.N1"D"!(Y?1N.N1"d")

               GOTO DISPLAY

 +6        QUIT 

TERM      ; EDIT THE ENTRY

 +1        IF $PIECE(GMRGINFO("CLAS"),U,2)="PRIME DOCUMENT"

               WRITE !,"NAME: ",$PIECE(GMRGINFO("TEXT"),U),"// (UNEDITABLE)"

 +2       IF '$TEST

               Begin DoDot:1

 +3                KILL GMRGRASK

                   WRITE !,"NAME:"

                   SET (GMRGTX("@"),GMRGTX(1))=0

                   SET GMRGTX(0)=$PIECE(GMRGINFO("TEXT"),"^")

                   DO EN1^GMRGED3

                   SET X=$SELECT(GMRGTX(0)'="":GMRGTX(0),1:"@")

                   IF GMRGOUT

                       SET GMRGOUT=0

                       QUIT 

 +4                IF X?1P.E

                       IF X'?1"[".E

                           IF X'?1"<".E

                               WRITE !?3,$CHAR(7),$SELECT(X="@":"CANNOT DELETE",1:"Answer must free text 3-60 characters")

                               SET GMRGRASK=1

                               QUIT 

 +5                IF X'=$PIECE(GMRGINFO("TEXT"),"^")

                       SET GMRGT=X

                       DO CHK^GMRGTGI0

                       if GMRGOUT!GMRGDUP

                           QUIT 

                       WRITE !,".changing '",$PIECE(GMRGINFO("TEXT"),"^"),"' to '",GMRGT,"'"

                       SET DIE="^GMRD(124.2,"

                       SET DA=GMRGINFO

                       SET DR=".01///^S X=GMRGT"

                       DO ^DIE

                       IF $SELECT($DATA(Y):1,1:0)

                           SET GMRGRASK=1

                           QUIT 

 +6                QUIT 

               End DoDot:1

               if GMRGOUT

                   QUIT 

               IF $GET(GMRGRASK)

                   KILL GMRGRASK

                   GOTO TERM

 +7        SET DA=GMRGINFO

           SET DIE="^GMRD(124.2,"

           SET DR="[GMRG EDIT TERM]"

           DO ^DIE

           KILL DIC

 +8        SET X="`"_DA

           SET DIC=DIE

           SET DIC(0)="Q"

           DO ^DIC

           IF +Y>0

               KILL GMRGINFO

               SET GMRGINFO=+Y

               DO INFOSET^GMRGTGI0

 +9        QUIT 

SEL       ; EDIT THE SELETION

 +1        SET GMRGSEL=$PIECE(GMRGINFO("SEL",+Y),"^",2)

           DO DOWN^GMRGTGI1

           if GMRGOUT

               QUIT 

B          DO EN2^GMRGTGIF

           IF GMRGUP

               DO UP^GMRGTGI1

               SET GMRGUP=0

               QUIT 

 +1        if 'GMRGOUT

               GOTO B

 +2        QUIT 

ADD       ; ADD SELECTIONS

 +1        IF $PIECE(GMRGINFO("TYPE"),"^")=3

               WRITE !!?3,$CHAR(7),"You cannot add selections to an aggregate term which is of type 'TERM'"

 +2       IF $TEST

               WRITE !?3,"If you want to add selections for this term, then first edit the TYPE",!?3,"of this term and change it to something other than 'TERM'."

               QUIT 

 +3        WRITE !

           SET DX=$X

           SET DY=0

           XECUTE ^%ZOSF("XY")

           WRITE !,"Select term to add: "

           READ X:DTIME

           if '$TEST!(X="^")!(X="^^")

               SET GMRGOUT=1

           if X=""!GMRGOUT

               QUIT 

           SET GMRGX=X

 +4        SET DIC("S")="I GMRGINFO'=+Y,$P(^(0),U,2)'<$P(GMRGINFO(""TYPE""),U) S GMRGZ=$O(^GMRD(124.2,GMRGINFO,1,""B"",+Y,0)) I $S(GMRGZ'>0:1,'$D(^GMRD(124.2,GMRGINFO,1,GMRGZ,0)):1,'$P(^(0),U,6):0,1:1)"

           SET DIC(0)="EN"

           SET DIC="^GMRD(124.2,"

           DO ^DIC

 +5        KILL DIC

           if X?."?"

               GOTO ADD

           SET I(0)=$LENGTH(X)

           FOR I=1:1:I(0)

               if $EXTRACT(X)'=" "

                   QUIT 

               SET X=$EXTRACT(X,2,$LENGTH(X))

 +6        IF X=""

               WRITE $CHAR(7),"  ??"

               GOTO ADD

YNOK       IF +Y>0

               WRITE !,"Is this the entry you want"

               SET %=1

               DO YN^DICN

               if %=2

                   SET Y=-1

               if %=-1

                   SET GMRGOUT=1

               if %=1

                   SET GMRGX=X

               if GMRGOUT

                   QUIT 

               IF '%

                   WRITE !?5,"Answer Yes if this is the record you meant to select, else answer No."

                   GOTO YNOK

 +1        IF +Y'>0

               SET DIC("DR")=".02;K DIC(""S"");.03///^S X=GMRGPK"

               SET DLAYGO=124.2

               SET DIC(0)="EL"

               SET X=""""_GMRGX_""""

               SET DIC="^GMRD(124.2,"

               DO ^DIC

               KILL DIC,DLAYGO

               if +Y'>0

                   GOTO ADD

 +2        WRITE !

           if '$DATA(^GMRD(124.2,GMRGINFO,1,0))

               SET ^(0)="^124.21PI^^0"

           WRITE "."

 +3        SET GMRGZ=$ORDER(^GMRD(124.2,GMRGINFO,1,"B",+Y,0))

           SET GMRGZ(0)=+Y

 +4        IF GMRGZ>0

               SET DA(1)=GMRGINFO

               SET DA=GMRGZ

               SET DIE="^GMRD(124.2,DA(1),1,"

               SET DR="5///^S X=0"

               DO ^DIE

 +5        IF GMRGZ'>0

               SET X=+Y

               SET DIC="^GMRD(124.2,DA(1),1,"

               SET (D0,DA(1))=GMRGINFO

               SET DLAYGO=124.21

               SET DIC(0)="LZ"

               KILL DD

               DO FILE^DICN

               KILL DIC,DLAYGO

               WRITE "."

               IF +Y'>0

                   WRITE !?3,$CHAR(7),"Could not add this term to the selection list??"

                   GOTO ADD

 +6        KILL GMRGINFO

           SET GMRGINFO=DA(1)

           DO INFOSET^GMRGTGI0

           WRITE "added"

 +7        QUIT 

DELETE    ; DELETE SELECTIONS

 +1        WRITE !,"..."

           if $PIECE(GMRGRT(0),"^",3)'=GMRGPK

               GOTO STDLFL

 +2        SET DA(1)=GMRGINFO

           SET DIK="^GMRD(124.2,DA(1),1,"

           SET DA=$PIECE(GMRGINFO("SEL",+Y),"^")

           DO ^DIK

           GOTO RSINAR

STDLFL     SET DA(1)=GMRGINFO

           SET DA=$PIECE(GMRGINFO("SEL",+Y),"^")

           SET DIE="^GMRD(124.2,DA(1),1,"

           SET DR="5///^S X=1"

           DO ^DIE

RSINAR     WRITE "."

           KILL GMRGINFO

           SET GMRGINFO=DA(1)

           DO INFOSET^GMRGTGI0

           WRITE "deleted"

 +1        QUIT 

DISPLAY   ;

 +1        WRITE !!?3,$PIECE(GMRGINFO("SEL",+Y),"^",3)

           SET DA(1)=GMRGINFO

           SET DA=$PIECE(GMRGINFO("SEL",+Y),"^")

           SET DIE="^GMRD(124.2,DA(1),1,"

           SET DR=6_"     DISPLAY ORDER"

           DO ^DIE

           if $DATA(Y)

               SET GMRGOUT=1

           if GMRGOUT

               QUIT 

 +2        SET Y=GMRGINFO

           KILL GMRGINFO

           SET GMRGINFO=+Y

           DO INFOSET^GMRGTGI0

 +3        QUIT