source: WorldVistAEHR/trunk/r/GEN_MED_REC_GENERATOR-GMRG/GMRGXAGC.m@ 1710

Last change on this file since 1710 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.8 KB
RevLine 
[613]1GMRGXAGC ;CISC/RM-AGGREGATE TERM FILE CHANGES ;8/27/93
2 ;;3.0;Text Generator;;Jan 24, 1996
3POST ;
4 W !!,"Making corrections to aggregate term file entries"
5 F GMRGXAGC=1:1 S GMRGXAGC(0)=$P($T(CHIL+GMRGXAGC),";;",2) Q:GMRGXAGC(0)="" D FXCH0
6 F GMRGXAGC=1:1 S GMRGXAGC(0)=$P($T(OTHER+GMRGXAGC),";;",2) Q:GMRGXAGC(0)="" D FXOT0
7 Q
8PRE ;
9 W !!,"Making corrections to aggregate term file entries"
10 F GMRGXAGC=1:1 S GMRGXAGC(0)=$P($T(ZERO+GMRGXAGC),";;",2) Q:GMRGXAGC(0)="" D FXZR0
11 Q
12FXCH0 ;
13 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
14 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
15 Q:DA'>0 S DIK="^GMRD(124.2,DA(1),1," D ^DIK W "."
16 Q
17FXZR0 ;
18 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
19 F GMRGXAGC=.01,.02,.03,.05 D FZ
20 W "."
21 Q
22FZ ;
23 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)
24 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)
25 Q
26FXOT0 ;
27 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
28 S DR=+$P(GMRGXAGC(0),";",2) Q:DR'>0
29 S DR=DR_"///"_$P(GMRGXAGC(0),";",3),DIE="^GMRD(124.2," D ^DIE
30 Q
31CHIL ;;Parent;Child to delete
32 ;;
33ZERO ;;Old zero;New zero
34 ;;
35OTHER ;;Parent;Field #;New data (@=delete)
36 ;;Nursing Intervention/Orders^2^NURSC^^2;9;@
37 ;;
Note: See TracBrowser for help on using the repository browser.