GMRGTGI0 ;CISC/RM-PRIME DOCUMENT EDIT (cont.) ;1/9/89
;;3.0;Text Generator;;Jan 24, 1996
CHK ; CHECK FOR DUPLICATE .01 FIELD, IF THE SAME SET GMRGOUT=1
S GMRGDUP=0 Q:$P(GMRGINFO("CLAS"),"^",2)="PRIME DOCUMENT" F X=0:0 S X=$O(^GMRD(124.2,"B",GMRGT,X)) Q:X'>0 I X'=GMRGINFO S GMRGDUP=1 Q
S GMRGX=GMRGT
I 'GMRGDUP F X=0:0 Q:GMRGDUP S GMRGX=$O(^GMRD(124.2,"B",GMRGX)) Q:GMRGX=""!($E(GMRGX,1,$L(GMRGT))'=GMRGT) F GMRGX(0)=0:0 S GMRGX(0)=$O(^GMRD(124.2,"B",GMRGX,GMRGX(0))) Q:GMRGX(0)'>0 D DF Q:GMRGDUP
Q:'GMRGDUP
S X=GMRGT,DIC(0)="",DIC="^GMRD(124.2,",DIC("S")="I +Y'=GMRGINFO,+$P(^(0),U,2)'<+$P(GMRGINFO(""TYPE""),U)" D ^DIC K DIC S GMRGDUP=$S(+Y>0:1,1:2)
W !!,$C(7),"By changing '"_$P(GMRGINFO("TEXT"),"^")_"' to '"_GMRGT_"'",!,"you may have created a duplicate term."
DUPOK W !,"Would you like to look at the list of possible duplicates" S %=2 D YN^DICN S:%=-1 GMRGOUT=1 S:%=2 GMRGDUP=0 Q:%=-1!(%=2)
I '% W !?3,$C(7),"Answer 'YES' if you think you may want to use one of the duplicates",!?3,"instead of this term, answer 'NO' if you want to change the text of",!?3,"the term you are presently editing." G DUPOK
G:GMRGDUP=1 DUPRO
CHDUP ;
W " If you meant to use one of the ",!,"following selections instead enter the appropriate number, else press '^'.",!
S DX=$X,DY=0 X ^%ZOSF("XY") S DIC="^GMRD(124.2,",X=GMRGT,DIC(0)="EZ",DIC("S")="I +Y'=GMRGINFO,+$P(^(0),U,2)'<+$P(GMRGINFO(""TYPE""),U)" D ^DIC I $D(DTOUT) S GMRGOUT=1 Q
I +Y'>0 S GMRGDUP=0 Q
G DUPFND
DUPRO ;
W !!,GMRGT S DX=$X,DY=0 X ^%ZOSF("XY") S DIC("S")="I +Y'=GMRGINFO,+$P(^(0),U,2)'<+$P(GMRGINFO(""TYPE""),U)",DIC(0)="OZE",DIC="^GMRD(124.2,",X=GMRGT D ^DIC
DUPYN W !,"Did you mean to use the above selection instead" S %=0 D YN^DICN I %'=0 S:%=-1 GMRGOUT=1 S:%=2 GMRGDUP=0 Q:%=-1!(%=2)
I '% W !?5,"Answer Yes if you want to use the above selection instead of creating",!?5,"a duplicate, answer No if you want to create a duplicate." G DUPYN
DUPFND ;
S GMRGNUP=$S($D(^TMP($J,"GMRGINFO",GMRGLEVL)):$P(^(GMRGLEVL),"^"),1:"") Q:GMRGNUP'>0
S GMRGCYC(0)=+Y,GMRGND=GMRGNUP,GMRGCYC=0 D FNDPRM^GMRGRUT0 K:'GMRGCYC GMRGCYC I $D(GMRGCYC)!(+Y=GMRGNUP) W !?5,$C(7),"ADDING THIS TERM WOULD CREATE AN INVALID DATA CONDITION, CANNOT ADD!!" K GMRGCYC Q
S GMRGANW=+Y W !,".replacing '",$P(GMRGINFO("TEXT"),"^"),"' with '",Y(0,0),"'."
S GMRGDOL=$O(^GMRD(124.2,GMRGNUP,1,"B",GMRGINFO,0)) Q:GMRGDOL'>0 W "."
S DA(1)=GMRGNUP,DA=GMRGDOL,DIK="^GMRD(124.2,DA(1),1," D ^DIK W "." S DIC=DIK,X=GMRGANW,DIC(0)="Q",DINUM=GMRGDOL K DD D FILE^DICN W "." I +Y>0 K GMRGINFO S GMRGINFO=$P(Y,"^",2) D INFOSET W "."
Q
DF ;
I GMRGX(0)'=GMRGINFO,$D(^GMRD(124.2,GMRGX(0),0)),+$P(^(0),"^",2)'<+$P(GMRGINFO("TYPE"),"^") S GMRGDUP=1 Q
Q
INFOSET ; FOR AN AGGY TERM WITH ENTRY OF GMRGINFO, WILL SET GMRGINFO ARRAY
S GMRGX=$S($D(^GMRD(124.2,GMRGINFO,0)):^(0),1:""),GMRGINFO("TEXT")=$P(GMRGX,"^")_"^"_$P(GMRGX,"^",5),GMRGINFO("TYPE")=$P(GMRGX,"^",2),GMRGINFO("PACK")=$P(GMRGX,"^",3)
S GMRGINFO("CLAS")=$P(GMRGX,"^",4)_"^"_$S($P(GMRGX,"^",4)="":"",$D(^GMRD(124.25,$P(GMRGX,"^",4),0)):$P(^(0),"^"),1:""),GMRGINFO("MIN")=$P(GMRGX,"^",6),GMRGINFO("MAX")=$P(GMRGX,"^",7),GMRGINFO("FORM")=$P(GMRGX,"^",8)
S GMRGINFO("ADD")=$P(GMRGX,"^",9),GMRGINFO("SPLIT")=$P(GMRGX,"^",10),GMRGINFO("TTOP")=$P(GMRGX,"^",11),GMRGINFO("SMES")=$P(GMRGX,"^",12)
S GMRGINFO("LEAD")=$S($D(^GMRD(124.2,GMRGINFO,4)):$P(^(4),"^"),1:""),GMRGINFO("TRAIL")=$S($D(^GMRD(124.2,GMRGINFO,5)):$P(^(5),"^"),1:""),GMRGINFO("ACTS")=$S($D(^GMRD(124.2,GMRGINFO,7)):$E(^(7),1,245),1:"")
S GMRGINFO("ACTF")=$S($D(^GMRD(124.2,GMRGINFO,8)):$E(^(8),1,245),1:""),GMRGY="",GMRGX=1
F GMRGY(1)=0:0 S GMRGY=$O(^GMRD(124.2,GMRGINFO,1,"AC",GMRGY)) Q:GMRGY="" F GMRGY(0)=0:0 S GMRGY(0)=$O(^GMRD(124.2,GMRGINFO,1,"AC",GMRGY,GMRGY(0))) Q:GMRGY(0)'>0 I $D(^GMRD(124.2,GMRGINFO,1,GMRGY(0),0)),'$P(^(0),"^",6) D SETSEL
S GMRGINFO("SEL")=GMRGX-1
Q
SETSEL ;
S GMRGZ=^GMRD(124.2,GMRGINFO,1,GMRGY(0),0),GMRGZ(0)=$S(+GMRGZ'>0:"",$D(^GMRD(124.2,+GMRGZ,0)):^(0),1:""),GMRGINFO("SEL",GMRGX)=GMRGY(0)_"^"_+GMRGZ_"^"_$P(GMRGZ(0),"^")_"^"_$P(GMRGZ,"^",7),GMRGX=GMRGX+1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRGTGI0 4095 printed Dec 13, 2024@01:55:37 Page 2
GMRGTGI0 ;CISC/RM-PRIME DOCUMENT EDIT (cont.) ;1/9/89
+1 ;;3.0;Text Generator;;Jan 24, 1996
CHK ; CHECK FOR DUPLICATE .01 FIELD, IF THE SAME SET GMRGOUT=1
+1 SET GMRGDUP=0
if $PIECE(GMRGINFO("CLAS"),"^",2)="PRIME DOCUMENT"
QUIT
FOR X=0:0
SET X=$ORDER(^GMRD(124.2,"B",GMRGT,X))
if X'>0
QUIT
IF X'=GMRGINFO
SET GMRGDUP=1
QUIT
+2 SET GMRGX=GMRGT
+3 IF 'GMRGDUP
FOR X=0:0
if GMRGDUP
QUIT
SET GMRGX=$ORDER(^GMRD(124.2,"B",GMRGX))
if GMRGX=""!($EXTRACT(GMRGX,1,$LENGTH(GMRGT))'=GMRGT)
QUIT
FOR GMRGX(0)=0:0
SET GMRGX(0)=$ORDER(^GMRD(124.2,"B",GMRGX,GMRGX(0)))
if GMRGX(0)'>0
QUIT
DO DF
if GMRGDUP
QUIT
+4 if 'GMRGDUP
QUIT
+5 SET X=GMRGT
SET DIC(0)=""
SET DIC="^GMRD(124.2,"
SET DIC("S")="I +Y'=GMRGINFO,+$P(^(0),U,2)'<+$P(GMRGINFO(""TYPE""),U)"
DO ^DIC
KILL DIC
SET GMRGDUP=$SELECT(+Y>0:1,1:2)
+6 WRITE !!,$CHAR(7),"By changing '"_$PIECE(GMRGINFO("TEXT"),"^")_"' to '"_GMRGT_"'",!,"you may have created a duplicate term."
DUPOK WRITE !,"Would you like to look at the list of possible duplicates"
SET %=2
DO YN^DICN
if %=-1
SET GMRGOUT=1
if %=2
SET GMRGDUP=0
if %=-1!(%=2)
QUIT
+1 IF '%
WRITE !?3,$CHAR(7),"Answer 'YES' if you think you may want to use one of the duplicates",!?3,"instead of this term, answer 'NO' if you want to change the text of",!?3,"the term you are presently editing."
GOTO DUPOK
+2 if GMRGDUP=1
GOTO DUPRO
CHDUP ;
+1 WRITE " If you meant to use one of the ",!,"following selections instead enter the appropriate number, else press '^'.",!
+2 SET DX=$X
SET DY=0
XECUTE ^%ZOSF("XY")
SET DIC="^GMRD(124.2,"
SET X=GMRGT
SET DIC(0)="EZ"
SET DIC("S")="I +Y'=GMRGINFO,+$P(^(0),U,2)'<+$P(GMRGINFO(""TYPE""),U)"
DO ^DIC
IF $DATA(DTOUT)
SET GMRGOUT=1
QUIT
+3 IF +Y'>0
SET GMRGDUP=0
QUIT
+4 GOTO DUPFND
DUPRO ;
+1 WRITE !!,GMRGT
SET DX=$X
SET DY=0
XECUTE ^%ZOSF("XY")
SET DIC("S")="I +Y'=GMRGINFO,+$P(^(0),U,2)'<+$P(GMRGINFO(""TYPE""),U)"
SET DIC(0)="OZE"
SET DIC="^GMRD(124.2,"
SET X=GMRGT
DO ^DIC
DUPYN WRITE !,"Did you mean to use the above selection instead"
SET %=0
DO YN^DICN
IF %'=0
if %=-1
SET GMRGOUT=1
if %=2
SET GMRGDUP=0
if %=-1!(%=2)
QUIT
+1 IF '%
WRITE !?5,"Answer Yes if you want to use the above selection instead of creating",!?5,"a duplicate, answer No if you want to create a duplicate."
GOTO DUPYN
DUPFND ;
+1 SET GMRGNUP=$SELECT($DATA(^TMP($JOB,"GMRGINFO",GMRGLEVL)):$PIECE(^(GMRGLEVL),"^"),1:"")
if GMRGNUP'>0
QUIT
+2 SET GMRGCYC(0)=+Y
SET GMRGND=GMRGNUP
SET GMRGCYC=0
DO FNDPRM^GMRGRUT0
if 'GMRGCYC
KILL GMRGCYC
IF $DATA(GMRGCYC)!(+Y=GMRGNUP)
WRITE !?5,$CHAR(7),"ADDING THIS TERM WOULD CREATE AN INVALID DATA CONDITION, CANNOT ADD!!"
KILL GMRGCYC
QUIT
+3 SET GMRGANW=+Y
WRITE !,".replacing '",$PIECE(GMRGINFO("TEXT"),"^"),"' with '",Y(0,0),"'."
+4 SET GMRGDOL=$ORDER(^GMRD(124.2,GMRGNUP,1,"B",GMRGINFO,0))
if GMRGDOL'>0
QUIT
WRITE "."
+5 SET DA(1)=GMRGNUP
SET DA=GMRGDOL
SET DIK="^GMRD(124.2,DA(1),1,"
DO ^DIK
WRITE "."
SET DIC=DIK
SET X=GMRGANW
SET DIC(0)="Q"
SET DINUM=GMRGDOL
KILL DD
DO FILE^DICN
WRITE "."
IF +Y>0
KILL GMRGINFO
SET GMRGINFO=$PIECE(Y,"^",2)
DO INFOSET
WRITE "."
+6 QUIT
DF ;
+1 IF GMRGX(0)'=GMRGINFO
IF $DATA(^GMRD(124.2,GMRGX(0),0))
IF +$PIECE(^(0),"^",2)'<+$PIECE(GMRGINFO("TYPE"),"^")
SET GMRGDUP=1
QUIT
+2 QUIT
INFOSET ; FOR AN AGGY TERM WITH ENTRY OF GMRGINFO, WILL SET GMRGINFO ARRAY
+1 SET GMRGX=$SELECT($DATA(^GMRD(124.2,GMRGINFO,0)):^(0),1:"")
SET GMRGINFO("TEXT")=$PIECE(GMRGX,"^")_"^"_$PIECE(GMRGX,"^",5)
SET GMRGINFO("TYPE")=$PIECE(GMRGX,"^",2)
SET GMRGINFO("PACK")=$PIECE(GMRGX,"^",3)
+2 SET GMRGINFO("CLAS")=$PIECE(GMRGX,"^",4)_"^"_$SELECT($PIECE(GMRGX,"^",4)="":"",$DATA(^GMRD(124.25,$PIECE(GMRGX,"^",4),0)):$PIECE(^(0),"^"),1:"")
SET GMRGINFO("MIN")=$PIECE(GMRGX,"^",6)
SET GMRGINFO("MAX")=$PIECE(GMRGX,"^",7)
SET GMRGINFO("FORM")=$PIECE(GMRGX,"^",8)
+3 SET GMRGINFO("ADD")=$PIECE(GMRGX,"^",9)
SET GMRGINFO("SPLIT")=$PIECE(GMRGX,"^",10)
SET GMRGINFO("TTOP")=$PIECE(GMRGX,"^",11)
SET GMRGINFO("SMES")=$PIECE(GMRGX,"^",12)
+4 SET GMRGINFO("LEAD")=$SELECT($DATA(^GMRD(124.2,GMRGINFO,4)):$PIECE(^(4),"^"),1:"")
SET GMRGINFO("TRAIL")=$SELECT($DATA(^GMRD(124.2,GMRGINFO,5)):$PIECE(^(5),"^"),1:"")
SET GMRGINFO("ACTS")=$SELECT($DATA(^GMRD(124.2,GMRGINFO,7)):$EXTRACT(^(7),1,245),1:"")
+5 SET GMRGINFO("ACTF")=$SELECT($DATA(^GMRD(124.2,GMRGINFO,8)):$EXTRACT(^(8),1,245),1:"")
SET GMRGY=""
SET GMRGX=1
+6 FOR GMRGY(1)=0:0
SET GMRGY=$ORDER(^GMRD(124.2,GMRGINFO,1,"AC",GMRGY))
if GMRGY=""
QUIT
FOR GMRGY(0)=0:0
SET GMRGY(0)=$ORDER(^GMRD(124.2,GMRGINFO,1,"AC",GMRGY,GMRGY(0)))
if GMRGY(0)'>0
QUIT
IF $DATA(^GMRD(124.2,GMRGINFO,1,GMRGY(0),0))
IF '$PIECE(^(0),"^",6)
DO SETSEL
+7 SET GMRGINFO("SEL")=GMRGX-1
+8 QUIT
SETSEL ;
+1 SET GMRGZ=^GMRD(124.2,GMRGINFO,1,GMRGY(0),0)
SET GMRGZ(0)=$SELECT(+GMRGZ'>0:"",$DATA(^GMRD(124.2,+GMRGZ,0)):^(0),1:"")
SET GMRGINFO("SEL",GMRGX)=GMRGY(0)_"^"_+GMRGZ_"^"_$PIECE(GMRGZ(0),"^")_"^"_$PIECE(GMRGZ,"^",7)
SET GMRGX=GMRGX+1
+2 QUIT
