- 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
- 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