| [613] | 1 | GMRGED5 ;CISC/RM-PATIENT DATA EDIT (cont.) ;4/25/89
|
|---|
| 2 | ;;3.0;Text Generator;;Jan 24, 1996
|
|---|
| 3 | APPEND ; EDIT APPENDED TEXT FOR THE SELECTED ENTRY.
|
|---|
| 4 | S (GMRGTX("OL"),GMRGTX)=$P(GMRGPRC(0),"^",3),GMRGTX("ACTION")=$P($P($P(GMRGPRC,"^",2),"/"),";",2,99)
|
|---|
| 5 | I GMRGTX("ACTION")="" D APPR
|
|---|
| 6 | I GMRGTX("ACTION")'="" S $P(GMRGTX,"|")=GMRGTX("ACTION")
|
|---|
| 7 | SAT I 'GMRGOUT,GMRGTX("OL")'=GMRGTX S X=GMRGTX("OL"),DA=$P(GMRGPRC(0),"^",2),DA(1)=GMRGPDA,GMRGY=2,GMRGAT=0,GMRGZ="" D EN1^GMRGUTL K GMRGAT,GMRGZ S $P(^GMR(124.3,DA(1),1,DA,0),"^",2)=GMRGTX,$P(GMRGPRC(0),"^",3)=GMRGTX
|
|---|
| 8 | I 'GMRGOUT,GMRGTX("OL")'=GMRGTX S ^TMP($J,"GMRGLVL",$P(GMRGLVL,"^"),GMRGTLVL,GMRGSLVL,0)=GMRGPRC(0)
|
|---|
| 9 | Q
|
|---|
| 10 | APPR ;
|
|---|
| 11 | W !!,"APPENDED TEXT for '" S GMRGXPRT(0)=$P(GMRGPRC(0),"^",3),GMRGXPRT=$P(GMRGPRC(0),"^"),GMRGXPRT(1)="19^"_(IOM)_"^1^0" D EN1^GMRGRUT2 W "'"
|
|---|
| 12 | S (GMRGTX("OLD"),GMRGTX(0))=$P(GMRGTX,"|") D APTXED S $P(GMRGTX,"|")=GMRGTX(0)
|
|---|
| 13 | Q
|
|---|
| 14 | APTXED ;
|
|---|
| 15 | I $L(GMRGTX(0))>15 S GMRGTX("@")=1,GMRGTX(1)=0 W ! D EN1^GMRGED3 G APTX0
|
|---|
| 16 | W !,"Appended Text: ",$S($L(GMRGTX(0)):GMRGTX(0)_"// ",1:"") R GMRGTX(0):DTIME S:GMRGTX(0)=""&$L(GMRGTX("OLD")) GMRGTX(0)=GMRGTX("OLD") S:GMRGTX(0)="^"!(GMRGTX(0)="^^")!'$T GMRGOUT=1 Q:GMRGOUT!(GMRGTX(0)="") G:GMRGTX(0)'="@" APTX0
|
|---|
| 17 | YNAP W !?4,$C(7),"WANT TO DELETE" S %=1 D YN^DICN S:%=-1 GMRGOUT=1 Q:GMRGOUT W:%=2 $C(7)," ??" S GMRGTX(0)=$S(%=2:GMRGTX("OLD"),%=1:"",1:GMRGTX(0))
|
|---|
| 18 | G APTXED:%=2,APTX0:%=1 W !?8,$C(7),"Answer Yes if you want to delete the appended text, else answer No" G YNAP
|
|---|
| 19 | APTX0 I $L((GMRGTX(0)_"|"_$P(GMRGTX,"|",2,$L(GMRGTX,"|"))))>175 W !?4,$C(7),"LINE TOO LONG??" S GMRGTX(0)=GMRGTX("OLD") G APTXED
|
|---|
| 20 | I GMRGTX(0)["^"!(GMRGTX(0)?1"?".E) W !?4,$C(7),$S(GMRGTX(0)?1"?".E:"ANSWER WITH FREE TEXT",1:"ANSWER CANNOT CONTAIN THE CIRCUMFLEX '^' CHARACTER") S GMRGTX(0)=GMRGTX("OLD") G APTXED
|
|---|
| 21 | Q
|
|---|
| 22 | ADDITION ;
|
|---|
| 23 | I '$P(GMRGTERM(0),"^",9) W !,$C(7),"CANNOT EDIT ADDITIONAL TEXT??" R !,"Press return to continue ",X:DTIME S:X="^"!(X="^^")!'$T GMRGOUT=1 Q
|
|---|
| 24 | W !!,"ADDITIONAL TEXT",!,$E(GMRGLIN("*"),1,15)
|
|---|
| 25 | S (GMRGTX,GMRGTX("OL"))=$S($P(GMRGPRC,"^",4)="":"",$D(^GMR(124.3,GMRGPDA,1,$P(GMRGPRC,"^",4),"ADD")):^("ADD"),1:"")
|
|---|
| 26 | EDTX W !!,"Additional Text for " S GMRGXPRT=$P(GMRGPRC,"^",3),GMRGXPRT(0)=$S($P(GMRGPRC,"^",4)="":"",$D(^GMR(124.3,GMRGPDA,1,$P(GMRGPRC,"^",4),0)):$P(^(0),"^",2),1:""),GMRGXPRT(1)="20^"_IOM_"^1" D EN1^GMRGRUT2
|
|---|
| 27 | I $L(GMRGTX)>15 S GMRGTX("@")=1,GMRGTX(1)=0,GMRGTX(0)=GMRGTX D EN1^GMRGED3 S GMRGTX=GMRGTX(0) G STDAT
|
|---|
| 28 | W ": ",$S($L(GMRGTX):GMRGTX_"// ",1:"") R GMRGTX:DTIME S:GMRGTX=""&$L(GMRGTX("OL")) GMRGTX=GMRGTX("OL") S:GMRGTX="^"!(GMRGTX="^^")!'$T GMRGOUT=1 Q:GMRGTX=""!GMRGOUT G:GMRGTX'="@" STDAT
|
|---|
| 29 | YNAT W !?4,$C(7),"WANT TO DELETE" S %=1 D YN^DICN S:%=-1 GMRGOUT=1 Q:GMRGOUT W:%=2 $C(7)," ??" S GMRGTX=$S(%=2:GMRGTX("OL"),%=1:"",1:GMRGTX)
|
|---|
| 30 | G EDTX:%=2,STDAT:%=1 W !?6,$C(7),"Answer Yes if you wish to delete the additional text, else answer No." G YNAT
|
|---|
| 31 | STDAT I $L(GMRGTX),($L(GMRGTX)<1!($L(GMRGTX)>245)!(GMRGTX?1P.E)) W !,$C(7),"ANSWER MUST BE 1-245 CHARACTERS IN LENGTH" S GMRGTX=GMRGTX("OL") G EDTX
|
|---|
| 32 | I GMRGTX("OL")'=GMRGTX S X=GMRGTX("OL"),DA=$P(GMRGPRC,"^",4),DA(1)=GMRGPDA,GMRGY=2,GMRGAT=1,GMRGZ="" D EN1^GMRGUTL S ^GMR(124.3,DA(1),1,DA,"ADD")=GMRGTX
|
|---|
| 33 | Q
|
|---|
