GMRGXAGC ;CISC/RM-AGGREGATE TERM FILE CHANGES ;8/27/93
;;3.0;Text Generator;;Jan 24, 1996
POST ;
W !!,"Making corrections to aggregate term file entries"
F GMRGXAGC=1:1 S GMRGXAGC(0)=$P($T(CHIL+GMRGXAGC),";;",2) Q:GMRGXAGC(0)="" D FXCH0
F GMRGXAGC=1:1 S GMRGXAGC(0)=$P($T(OTHER+GMRGXAGC),";;",2) Q:GMRGXAGC(0)="" D FXOT0
Q
PRE ;
W !!,"Making corrections to aggregate term file entries"
F GMRGXAGC=1:1 S GMRGXAGC(0)=$P($T(ZERO+GMRGXAGC),";;",2) Q:GMRGXAGC(0)="" D FXZR0
Q
FXCH0 ;
S DA(1)=$O(^GMRD(124.2,"AA",$P(GMRGXAGC(0),"^",3),$P(GMRGXAGC(0),"^",2),$P(GMRGXAGC(0),"^"),+$P(GMRGXAGC(0),"^",5),0)) Q:DA(1)'>0
F DA=0:0 S DA=$O(^GMRD(124.2,DA(1),1,DA)) Q:DA'>0 I $D(^GMRD(124.2,DA(1),1,DA,0)),$P(^(0),"^",2,5)=$P($P(GMRGXAGC(0),";",2),"^",1,4) Q
Q:DA'>0 S DIK="^GMRD(124.2,DA(1),1," D ^DIK W "."
Q
FXZR0 ;
S DA=$O(^GMRD(124.2,"AA",$P(GMRGXAGC(0),"^",3),$P(GMRGXAGC(0),"^",2),$P(GMRGXAGC(0),"^"),+$P(GMRGXAGC(0),"^",5),0)) Q:DA'>0
F GMRGXAGC=.01,.02,.03,.05 D FZ
W "."
Q
FZ ;
S X=$P($P(GMRGXAGC(0),";"),"^",100*GMRGXAGC) F GMRGXAGC(1)=0:0 S GMRGXAGC(1)=$O(^DD(124.2,GMRGXAGC,1,GMRGXAGC(1))) Q:GMRGXAGC(1)'>0 X:$D(^DD(124.2,GMRGXAGC,1,GMRGXAGC(1),2)) ^(2)
S X=$P($P(GMRGXAGC(0),";",2),"^",100*GMRGXAGC),$P(^GMRD(124.2,DA,0),"^",100*GMRGXAGC)=X F GMRGXAGC(1)=0:0 S GMRGXAGC(1)=$O(^DD(124.2,GMRGXAGC,1,GMRGXAGC(1))) Q:GMRGXAGC(1)'>0 X:$D(^DD(124.2,GMRGXAGC,1,GMRGXAGC(1),1)) ^(1)
Q
FXOT0 ;
S DA=$O(^GMRD(124.2,"AA",$P(GMRGXAGC(0),"^",3),$P(GMRGXAGC(0),"^",2),$P(GMRGXAGC(0),"^"),+$P(GMRGXAGC(0),"^",5),0)) Q:DA'>0
S DR=+$P(GMRGXAGC(0),";",2) Q:DR'>0
S DR=DR_"///"_$P(GMRGXAGC(0),";",3),DIE="^GMRD(124.2," D ^DIE
Q
CHIL ;;Parent;Child to delete
;;
ZERO ;;Old zero;New zero
;;
OTHER ;;Parent;Field #;New data (@=delete)
;;Nursing Intervention/Orders^2^NURSC^^2;9;@
;;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRGXAGC 1831 printed Oct 16, 2024@17:56:30 Page 2
GMRGXAGC ;CISC/RM-AGGREGATE TERM FILE CHANGES ;8/27/93
+1 ;;3.0;Text Generator;;Jan 24, 1996
POST ;
+1 WRITE !!,"Making corrections to aggregate term file entries"
+2 FOR GMRGXAGC=1:1
SET GMRGXAGC(0)=$PIECE($TEXT(CHIL+GMRGXAGC),";;",2)
if GMRGXAGC(0)=""
QUIT
DO FXCH0
+3 FOR GMRGXAGC=1:1
SET GMRGXAGC(0)=$PIECE($TEXT(OTHER+GMRGXAGC),";;",2)
if GMRGXAGC(0)=""
QUIT
DO FXOT0
+4 QUIT
PRE ;
+1 WRITE !!,"Making corrections to aggregate term file entries"
+2 FOR GMRGXAGC=1:1
SET GMRGXAGC(0)=$PIECE($TEXT(ZERO+GMRGXAGC),";;",2)
if GMRGXAGC(0)=""
QUIT
DO FXZR0
+3 QUIT
FXCH0 ;
+1 SET DA(1)=$ORDER(^GMRD(124.2,"AA",$PIECE(GMRGXAGC(0),"^",3),$PIECE(GMRGXAGC(0),"^",2),$PIECE(GMRGXAGC(0),"^"),+$PIECE(GMRGXAGC(0),"^",5),0))
if DA(1)'>0
QUIT
+2 FOR DA=0:0
SET DA=$ORDER(^GMRD(124.2,DA(1),1,DA))
if DA'>0
QUIT
IF $DATA(^GMRD(124.2,DA(1),1,DA,0))
IF $PIECE(^(0),"^",2,5)=$PIECE($PIECE(GMRGXAGC(0),";",2),"^",1,4)
QUIT
+3 if DA'>0
QUIT
SET DIK="^GMRD(124.2,DA(1),1,"
DO ^DIK
WRITE "."
+4 QUIT
FXZR0 ;
+1 SET DA=$ORDER(^GMRD(124.2,"AA",$PIECE(GMRGXAGC(0),"^",3),$PIECE(GMRGXAGC(0),"^",2),$PIECE(GMRGXAGC(0),"^"),+$PIECE(GMRGXAGC(0),"^",5),0))
if DA'>0
QUIT
+2 FOR GMRGXAGC=.01,.02,.03,.05
DO FZ
+3 WRITE "."
+4 QUIT
FZ ;
+1 SET X=$PIECE($PIECE(GMRGXAGC(0),";"),"^",100*GMRGXAGC)
FOR GMRGXAGC(1)=0:0
SET GMRGXAGC(1)=$ORDER(^DD(124.2,GMRGXAGC,1,GMRGXAGC(1)))
if GMRGXAGC(1)'>0
QUIT
if $DATA(^DD(124.2,GMRGXAGC,1,GMRGXAGC(1),2))
XECUTE ^(2)
+2 SET X=$PIECE($PIECE(GMRGXAGC(0),";",2),"^",100*GMRGXAGC)
SET $PIECE(^GMRD(124.2,DA,0),"^",100*GMRGXAGC)=X
FOR GMRGXAGC(1)=0:0
SET GMRGXAGC(1)=$ORDER(^DD(124.2,GMRGXAGC,1,GMRGXAGC(1)))
if GMRGXAGC(1)'>0
QUIT
if $DATA(^DD(124.2,GMRGXAGC,1,GMRGXAGC(1),1))
XECUTE ^(1)
+3 QUIT
FXOT0 ;
+1 SET DA=$ORDER(^GMRD(124.2,"AA",$PIECE(GMRGXAGC(0),"^",3),$PIECE(GMRGXAGC(0),"^",2),$PIECE(GMRGXAGC(0),"^"),+$PIECE(GMRGXAGC(0),"^",5),0))
if DA'>0
QUIT
+2 SET DR=+$PIECE(GMRGXAGC(0),";",2)
if DR'>0
QUIT
+3 SET DR=DR_"///"_$PIECE(GMRGXAGC(0),";",3)
SET DIE="^GMRD(124.2,"
DO ^DIE
+4 QUIT
CHIL ;;Parent;Child to delete
+1 ;;
ZERO ;;Old zero;New zero
+1 ;;
OTHER ;;Parent;Field #;New data (@=delete)
+1 ;;Nursing Intervention/Orders^2^NURSC^^2;9;@
+2 ;;
