- GMRGUT0 ;HIRMFO/RM-UTILITIES ROUTINE FOR GMRG FILES (CONT.) ;9/11/95
- ;;3.0;Text Generator;;Jan 24, 1996
- EN1 ; ENTRY FROM AUDT XREF ON SELECTION:AUDIT TRAIL:MODIFICATION
- ; FIELD OF THE GMR TEXT FILE (#124.3). THIS XREF SETS THE
- ; SELECTION:AUDIT TRAIL:MODIFIED TEXT FIELD TO THE VALUE OF THE
- ; SELECTION:ADDITIONAL TEXT FIELD AND DELETES THE DATA IN THE
- ; SELECTION:ADDITIONAL FIELD IF A RECORD IS BEING FLAGGED AS
- ; DELETED.
- S GMRG("DAX")=DA(2)_"^"_DA(1)_"^"_DA_"^"_X,GMRGT=$S($D(^GMR(124.3,DA(2),1,DA(1),0)):^(0),1:""),X=$P(GMRGT,"^",2),$P(GMRG(0),"^",2)=$P(GMRGT,"^"),$P(GMRG(0),"^",3)=$S($D(^GMR(124.3,DA(2),1,DA(1),2,DA,0)):$P(^(0),"^"),1:"")
- S DA=0 F GMRG=0:0 S GMRG=$O(^GMR(124.3,DA(2),1,DA(1),2,"AA",GMRG)) Q:GMRG'>0!(DA>0) F GMRG(1)=0:0 S GMRG(1)=$O(^(GMRG,GMRG(1))) Q:GMRG(1)'>0!(DA>0) F DA=0:0 S DA=$O(^(GMRG(1),DA)) Q:DA'>0 I DA'=$P(GMRG("DAX"),"^",3) Q
- I X'="" D TEXT^GMRGUTL,DELAD
- S X=$S($D(^GMR(124.3,DA(2),1,DA(1),"ADD")):^("ADD"),1:"") I X'="" D ADTX^GMRGUTL,DELTX
- S $P(GMRG(0),"^")=$S($D(^GMR(124.3,DA(2),1,DA(1),0)):$P(^(0),"^"),1:"")
- I $P(GMRG(0),"^")'="" F GMRG(1)=0:0 S GMRG(1)=$O(^GMRD(124.2,$P(GMRG(0),"^"),1,"B",GMRG(1))) Q:GMRG(1)'>0 D:$D(^GMR(124.3,DA(2),1,"B",GMRG(1))) DELCH
- S DA(2)=$P(GMRG("DAX"),"^"),DA(1)=$P(GMRG("DAX"),"^",2),DA=$P(GMRG("DAX"),"^",3),X=$P(GMRG("DAX"),"^",4) K GMRG,GMRGLDT,GMRGT
- Q
- DELAD ; DELETE ADDITIONAL TEXT IF SELECTION IS BEING FLAGGED AS DELETED
- S GMRGDAZ(1)=DA(1),GMRGDAZ=DA,DA(1)=DA(2),DA=DA(1) F GMRG=0:0 S GMRG=$O(^DD(124.31,1,1,GMRG)) Q:GMRG'>0 X:$P(^DD(124.31,1,1,GMRG,0),"^",2)'="AUD2"&$D(^DD(124.31,1,1,GMRG,2)) ^(2)
- S DA(1)=GMRGDAZ(1),DA=GMRGDAZ,$P(^GMR(124.3,DA(2),1,DA(1),0),"^",2)="" K GMRGDAZ
- Q
- DELTX ;
- S GMRGDAZ(1)=DA(1),GMRGDAZ=DA,DA(1)=DA(2),DA=DA(1) F GMRG=0:0 S GMRG=$O(^DD(124.31,1,2,GMRG)) Q:GMRG'>0 X:$P(^DD(124.31,1,2,GMRG,0),"^",2)'="AUD3"&$D(^DD(124.31,1,2,GMRG,2)) ^(2)
- S DA(1)=GMRGDAZ(1),DA=GMRGDAZ,^GMR(124.3,DA(2),1,DA(1),"ADD")="" K GMRGDAZ
- Q
- DELCH ; DELETE CHILDREN OF A SELECTION IF ITSELF IS DELETED.
- S GMRGT=$P(GMRG(0),"^",2,3)_"^"_GMRG(1) N GMRG W:$D(GMRGDFLG) "."
- S GMRG(1)=$P(GMRGT,"^",3),DA(1)=$O(^GMR(124.3,DA(2),1,"B",GMRG(1),0)),GMRGXY("DT0")=$P(GMRGT,"^",2),$P(GMRG(0),"^",2)=$P(GMRGT,"^")
- S GMRGT=1 F GMRGT(0)=0:0 S GMRGT(0)=$O(^GMRD(124.2,"AKID",GMRG(1),GMRGT(0))) Q:GMRGT(0)'>0 I $D(^GMR(124.3,DA(2),1,"ALIST",GMRGT(0))),GMRGT(0)'=$P(GMRG(0),"^",2) S GMRGT=0 Q
- G:'GMRGT QD
- I DA(1)'>0 G QD
- S DA=$P(^GMR(124.3,DA(2),1,DA(1),2,0),"^",3)
- LD S DA=DA+1 I $D(^GMR(124.3,DA(2),1,DA(1),2,DA,0)) G LD
- S GMRGST(1)=DA(2),GMRGST=DA(1) D STAT^GMRGRUT0 G QD:'$P(GMRGSTAT,"^",3) S GMRGLDT=+$P(GMRGSTAT,"^",2),%=GMRGXY("DT0") D PAST^GMRGUTL:%'>GMRGLDT
- S GMRGXY("DT0")=%,^GMR(124.3,DA(2),1,DA(1),2,DA,0)=GMRGXY("DT0")_"^"_0_"^"_DUZ,$P(^GMR(124.3,DA(2),1,DA(1),2,0),"^",3,4)=DA_"^"_($P(^GMR(124.3,DA(2),1,DA(1),2,0),"^",4)+1)
- F GMRGXY=.01,1,2 S X=$S(GMRGXY=.01:GMRGXY("DT0"),GMRGXY=1:0,1:DUZ) F GMRGXY(0)=0:0 S GMRGXY(0)=$O(^DD(124.313,GMRGXY,1,GMRGXY(0))) Q:GMRGXY(0)'>0 X:$D(^DD(124.313,GMRGXY,1,GMRGXY(0),1)) ^(1)
- D EN1
- QD K GMRGXY,GMRGSTAT
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRGUT0 3106 printed Feb 18, 2025@23:22:04 Page 2
- GMRGUT0 ;HIRMFO/RM-UTILITIES ROUTINE FOR GMRG FILES (CONT.) ;9/11/95
- +1 ;;3.0;Text Generator;;Jan 24, 1996
- EN1 ; ENTRY FROM AUDT XREF ON SELECTION:AUDIT TRAIL:MODIFICATION
- +1 ; FIELD OF THE GMR TEXT FILE (#124.3). THIS XREF SETS THE
- +2 ; SELECTION:AUDIT TRAIL:MODIFIED TEXT FIELD TO THE VALUE OF THE
- +3 ; SELECTION:ADDITIONAL TEXT FIELD AND DELETES THE DATA IN THE
- +4 ; SELECTION:ADDITIONAL FIELD IF A RECORD IS BEING FLAGGED AS
- +5 ; DELETED.
- +6 SET GMRG("DAX")=DA(2)_"^"_DA(1)_"^"_DA_"^"_X
- SET GMRGT=$SELECT($DATA(^GMR(124.3,DA(2),1,DA(1),0)):^(0),1:"")
- SET X=$PIECE(GMRGT,"^",2)
- SET $PIECE(GMRG(0),"^",2)=$PIECE(GMRGT,"^")
- SET $PIECE(GMRG(0),"^",3)=$SELECT($DATA(^GMR(124.3,DA(2),1,DA(1),2,DA,0)):$PIECE(^(0),"^"),1:"")
- +7 SET DA=0
- FOR GMRG=0:0
- SET GMRG=$ORDER(^GMR(124.3,DA(2),1,DA(1),2,"AA",GMRG))
- if GMRG'>0!(DA>0)
- QUIT
- FOR GMRG(1)=0:0
- SET GMRG(1)=$ORDER(^(GMRG,GMRG(1)))
- if GMRG(1)'>0!(DA>0)
- QUIT
- FOR DA=0:0
- SET DA=$ORDER(^(GMRG(1),DA))
- if DA'>0
- QUIT
- IF DA'=$PIECE(GMRG("DAX"),"^",3)
- QUIT
- +8 IF X'=""
- DO TEXT^GMRGUTL
- DO DELAD
- +9 SET X=$SELECT($DATA(^GMR(124.3,DA(2),1,DA(1),"ADD")):^("ADD"),1:"")
- IF X'=""
- DO ADTX^GMRGUTL
- DO DELTX
- +10 SET $PIECE(GMRG(0),"^")=$SELECT($DATA(^GMR(124.3,DA(2),1,DA(1),0)):$PIECE(^(0),"^"),1:"")
- +11 IF $PIECE(GMRG(0),"^")'=""
- FOR GMRG(1)=0:0
- SET GMRG(1)=$ORDER(^GMRD(124.2,$PIECE(GMRG(0),"^"),1,"B",GMRG(1)))
- if GMRG(1)'>0
- QUIT
- if $DATA(^GMR(124.3,DA(2),1,"B",GMRG(1)))
- DO DELCH
- +12 SET DA(2)=$PIECE(GMRG("DAX"),"^")
- SET DA(1)=$PIECE(GMRG("DAX"),"^",2)
- SET DA=$PIECE(GMRG("DAX"),"^",3)
- SET X=$PIECE(GMRG("DAX"),"^",4)
- KILL GMRG,GMRGLDT,GMRGT
- +13 QUIT
- DELAD ; DELETE ADDITIONAL TEXT IF SELECTION IS BEING FLAGGED AS DELETED
- +1 SET GMRGDAZ(1)=DA(1)
- SET GMRGDAZ=DA
- SET DA(1)=DA(2)
- SET DA=DA(1)
- FOR GMRG=0:0
- SET GMRG=$ORDER(^DD(124.31,1,1,GMRG))
- if GMRG'>0
- QUIT
- if $PIECE(^DD(124.31,1,1,GMRG,0),"^",2)'="AUD2"&$DATA(^DD(124.31,1,1,GMRG,2))
- XECUTE ^(2)
- +2 SET DA(1)=GMRGDAZ(1)
- SET DA=GMRGDAZ
- SET $PIECE(^GMR(124.3,DA(2),1,DA(1),0),"^",2)=""
- KILL GMRGDAZ
- +3 QUIT
- DELTX ;
- +1 SET GMRGDAZ(1)=DA(1)
- SET GMRGDAZ=DA
- SET DA(1)=DA(2)
- SET DA=DA(1)
- FOR GMRG=0:0
- SET GMRG=$ORDER(^DD(124.31,1,2,GMRG))
- if GMRG'>0
- QUIT
- if $PIECE(^DD(124.31,1,2,GMRG,0),"^",2)'="AUD3"&$DATA(^DD(124.31,1,2,GMRG,2))
- XECUTE ^(2)
- +2 SET DA(1)=GMRGDAZ(1)
- SET DA=GMRGDAZ
- SET ^GMR(124.3,DA(2),1,DA(1),"ADD")=""
- KILL GMRGDAZ
- +3 QUIT
- DELCH ; DELETE CHILDREN OF A SELECTION IF ITSELF IS DELETED.
- +1 SET GMRGT=$PIECE(GMRG(0),"^",2,3)_"^"_GMRG(1)
- NEW GMRG
- if $DATA(GMRGDFLG)
- WRITE "."
- +2 SET GMRG(1)=$PIECE(GMRGT,"^",3)
- SET DA(1)=$ORDER(^GMR(124.3,DA(2),1,"B",GMRG(1),0))
- SET GMRGXY("DT0")=$PIECE(GMRGT,"^",2)
- SET $PIECE(GMRG(0),"^",2)=$PIECE(GMRGT,"^")
- +3 SET GMRGT=1
- FOR GMRGT(0)=0:0
- SET GMRGT(0)=$ORDER(^GMRD(124.2,"AKID",GMRG(1),GMRGT(0)))
- if GMRGT(0)'>0
- QUIT
- IF $DATA(^GMR(124.3,DA(2),1,"ALIST",GMRGT(0)))
- IF GMRGT(0)'=$PIECE(GMRG(0),"^",2)
- SET GMRGT=0
- QUIT
- +4 if 'GMRGT
- GOTO QD
- +5 IF DA(1)'>0
- GOTO QD
- +6 SET DA=$PIECE(^GMR(124.3,DA(2),1,DA(1),2,0),"^",3)
- LD SET DA=DA+1
- IF $DATA(^GMR(124.3,DA(2),1,DA(1),2,DA,0))
- GOTO LD
- +1 SET GMRGST(1)=DA(2)
- SET GMRGST=DA(1)
- DO STAT^GMRGRUT0
- if '$PIECE(GMRGSTAT,"^",3)
- GOTO QD
- SET GMRGLDT=+$PIECE(GMRGSTAT,"^",2)
- SET %=GMRGXY("DT0")
- if %'>GMRGLDT
- DO PAST^GMRGUTL
- +2 SET GMRGXY("DT0")=%
- SET ^GMR(124.3,DA(2),1,DA(1),2,DA,0)=GMRGXY("DT0")_"^"_0_"^"_DUZ
- SET $PIECE(^GMR(124.3,DA(2),1,DA(1),2,0),"^",3,4)=DA_"^"_($PIECE(^GMR(124.3,DA(2),1,DA(1),2,0),"^",4)+1)
- +3 FOR GMRGXY=.01,1,2
- SET X=$SELECT(GMRGXY=.01:GMRGXY("DT0"),GMRGXY=1:0,1:DUZ)
- FOR GMRGXY(0)=0:0
- SET GMRGXY(0)=$ORDER(^DD(124.313,GMRGXY,1,GMRGXY(0)))
- if GMRGXY(0)'>0
- QUIT
- if $DATA(^DD(124.313,GMRGXY,1,GMRGXY(0),1))
- XECUTE ^(1)
- +4 DO EN1
- QD KILL GMRGXY,GMRGSTAT
- +1 QUIT