source: WorldVistAEHR/trunk/r/GEN_MED_REC_GENERATOR-GMRG/GMRGTGI2.m@ 1476

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

initial load of WorldVistAEHR

File size: 3.7 KB
RevLine 
[613]1GMRGTGI2 ;CISC/RM,RTK-PRIME DOCUMENT EDIT (cont.) ;8/23/93
2 ;;3.0;Text Generator;;Jan 24, 1996
3EN1 ; ENTRY FROM CHOOSING WHETHER TO EDIT THE TERM, EDIT THE SELECTION
4 ; ADD A SELECTION OR DELETE A SELECTION.
5 ; Y=$S(#:EDIT SEL.,"T"!"t":EDIT TERM,"A"!"a":ADD,#_@:DELETE)
6 I 'GMRGINFO("SEL"),Y?1N.N0.1"@" W !,$C(7),"NO SELECTIONS!!" Q
7 I Y?1N.N0.1"@"!(Y?1N.N1"D")!(Y?1N.N1"d") I +Y<1!(+Y>GMRGINFO("SEL")) W !?3,$C(7),"CHOOSE A NUMBER IN THE SELECTION LIST ABOVE PLEASE" Q
8 G TERM:"Tt"[Y,ADD:"Aa"[Y,DELETE:Y?1N.N1"@",SEL:Y?1N.N,DISPLAY:Y?1N.N1"D"!(Y?1N.N1"d")
9 Q
10TERM ; EDIT THE ENTRY
11 I $P(GMRGINFO("CLAS"),U,2)="PRIME DOCUMENT" W !,"NAME: ",$P(GMRGINFO("TEXT"),U),"// (UNEDITABLE)"
12 E D Q:GMRGOUT I $G(GMRGRASK) K GMRGRASK G TERM
13 . K GMRGRASK W !,"NAME:" S (GMRGTX("@"),GMRGTX(1))=0,GMRGTX(0)=$P(GMRGINFO("TEXT"),"^") D EN1^GMRGED3 S X=$S(GMRGTX(0)'="":GMRGTX(0),1:"@") I GMRGOUT S GMRGOUT=0 Q
14 . I X?1P.E,X'?1"[".E,X'?1"<".E W !?3,$C(7),$S(X="@":"CANNOT DELETE",1:"Answer must free text 3-60 characters") S GMRGRASK=1 Q
15 . I X'=$P(GMRGINFO("TEXT"),"^") S GMRGT=X D CHK^GMRGTGI0 Q:GMRGOUT!GMRGDUP W !,".changing '",$P(GMRGINFO("TEXT"),"^"),"' to '",GMRGT,"'" S DIE="^GMRD(124.2,",DA=GMRGINFO,DR=".01///^S X=GMRGT" D ^DIE I $S($D(Y):1,1:0) S GMRGRASK=1 Q
16 . Q
17 S DA=GMRGINFO,DIE="^GMRD(124.2,",DR="[GMRG EDIT TERM]" D ^DIE K DIC
18 S X="`"_DA,DIC=DIE,DIC(0)="Q" D ^DIC I +Y>0 K GMRGINFO S GMRGINFO=+Y D INFOSET^GMRGTGI0
19 Q
20SEL ; EDIT THE SELETION
21 S GMRGSEL=$P(GMRGINFO("SEL",+Y),"^",2) D DOWN^GMRGTGI1 Q:GMRGOUT
22B D EN2^GMRGTGIF I GMRGUP D UP^GMRGTGI1 S GMRGUP=0 Q
23 G:'GMRGOUT B
24 Q
25ADD ; ADD SELECTIONS
26 I $P(GMRGINFO("TYPE"),"^")=3 W !!?3,$C(7),"You cannot add selections to an aggregate term which is of type 'TERM'"
27 I W !?3,"If you want to add selections for this term, then first edit the TYPE",!?3,"of this term and change it to something other than 'TERM'." Q
28 W ! S DX=$X,DY=0 X ^%ZOSF("XY") W !,"Select term to add: " R X:DTIME S:'$T!(X="^")!(X="^^") GMRGOUT=1 Q:X=""!GMRGOUT S GMRGX=X
29 S DIC("S")="I GMRGINFO'=+Y,$P(^(0),U,2)'<$P(GMRGINFO(""TYPE""),U) S GMRGZ=$O(^GMRD(124.2,GMRGINFO,1,""B"",+Y,0)) I $S(GMRGZ'>0:1,'$D(^GMRD(124.2,GMRGINFO,1,GMRGZ,0)):1,'$P(^(0),U,6):0,1:1)",DIC(0)="EN",DIC="^GMRD(124.2," D ^DIC
30 K DIC G:X?."?" ADD S I(0)=$L(X) F I=1:1:I(0) Q:$E(X)'=" " S X=$E(X,2,$L(X))
31 I X="" W $C(7)," ??" G ADD
32YNOK I +Y>0 W !,"Is this the entry you want" S %=1 D YN^DICN S:%=2 Y=-1 S:%=-1 GMRGOUT=1 S:%=1 GMRGX=X Q:GMRGOUT I '% W !?5,"Answer Yes if this is the record you meant to select, else answer No." G YNOK
33 I +Y'>0 S DIC("DR")=".02;K DIC(""S"");.03///^S X=GMRGPK",DLAYGO=124.2,DIC(0)="EL",X=""""_GMRGX_"""",DIC="^GMRD(124.2," D ^DIC K DIC,DLAYGO G:+Y'>0 ADD
34 W ! S:'$D(^GMRD(124.2,GMRGINFO,1,0)) ^(0)="^124.21PI^^0" W "."
35 S GMRGZ=$O(^GMRD(124.2,GMRGINFO,1,"B",+Y,0)),GMRGZ(0)=+Y
36 I GMRGZ>0 S DA(1)=GMRGINFO,DA=GMRGZ,DIE="^GMRD(124.2,DA(1),1,",DR="5///^S X=0" D ^DIE
37 I GMRGZ'>0 S X=+Y,DIC="^GMRD(124.2,DA(1),1,",(D0,DA(1))=GMRGINFO,DLAYGO=124.21,DIC(0)="LZ" K DD D FILE^DICN K DIC,DLAYGO W "." I +Y'>0 W !?3,$C(7),"Could not add this term to the selection list??" G ADD
38 K GMRGINFO S GMRGINFO=DA(1) D INFOSET^GMRGTGI0 W "added"
39 Q
40DELETE ; DELETE SELECTIONS
41 W !,"..." G:$P(GMRGRT(0),"^",3)'=GMRGPK STDLFL
42 S DA(1)=GMRGINFO,DIK="^GMRD(124.2,DA(1),1,",DA=$P(GMRGINFO("SEL",+Y),"^") D ^DIK G RSINAR
43STDLFL S DA(1)=GMRGINFO,DA=$P(GMRGINFO("SEL",+Y),"^"),DIE="^GMRD(124.2,DA(1),1,",DR="5///^S X=1" D ^DIE
44RSINAR W "." K GMRGINFO S GMRGINFO=DA(1) D INFOSET^GMRGTGI0 W "deleted"
45 Q
46DISPLAY ;
47 W !!?3,$P(GMRGINFO("SEL",+Y),"^",3) S DA(1)=GMRGINFO,DA=$P(GMRGINFO("SEL",+Y),"^"),DIE="^GMRD(124.2,DA(1),1,",DR=6_" DISPLAY ORDER" D ^DIE S:$D(Y) GMRGOUT=1 Q:GMRGOUT
48 S Y=GMRGINFO K GMRGINFO S GMRGINFO=+Y D INFOSET^GMRGTGI0
49 Q
Note: See TracBrowser for help on using the repository browser.