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 ---[H[J[2J[HGMRGTGI2 3806 printed Oct 16, 2024@17:56:21 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