GMRGED5.m

GMRGED5 ;CISC/RM-PATIENT DATA EDIT (cont.) ;4/25/89

 ;;3.0;Text Generator;;Jan 24, 1996

APPEND ; EDIT APPENDED TEXT FOR THE SELECTED ENTRY.

 S (GMRGTX("OL"),GMRGTX)=$P(GMRGPRC(0),"^",3),GMRGTX("ACTION")=$P($P($P(GMRGPRC,"^",2),"/"),";",2,99)

 I GMRGTX("ACTION")="" D APPR

 I GMRGTX("ACTION")'="" S $P(GMRGTX,"|")=GMRGTX("ACTION")

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

 I 'GMRGOUT,GMRGTX("OL")'=GMRGTX S ^TMP($J,"GMRGLVL",$P(GMRGLVL,"^"),GMRGTLVL,GMRGSLVL,0)=GMRGPRC(0)

 Q

APPR ;

 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 "'"

 S (GMRGTX("OLD"),GMRGTX(0))=$P(GMRGTX,"|") D APTXED S $P(GMRGTX,"|")=GMRGTX(0)

 Q

APTXED ;

 I $L(GMRGTX(0))>15 S GMRGTX("@")=1,GMRGTX(1)=0 W ! D EN1^GMRGED3 G APTX0

 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

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))

 G APTXED:%=2,APTX0:%=1 W !?8,$C(7),"Answer Yes if you want to delete the appended text, else answer No" G YNAP

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

 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

 Q

ADDITION ;

 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

 W !!,"ADDITIONAL TEXT",!,$E(GMRGLIN("*"),1,15)

 S (GMRGTX,GMRGTX("OL"))=$S($P(GMRGPRC,"^",4)="":"",$D(^GMR(124.3,GMRGPDA,1,$P(GMRGPRC,"^",4),"ADD")):^("ADD"),1:"")

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

 I $L(GMRGTX)>15 S GMRGTX("@")=1,GMRGTX(1)=0,GMRGTX(0)=GMRGTX D EN1^GMRGED3 S GMRGTX=GMRGTX(0) G STDAT

 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

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)

 G EDTX:%=2,STDAT:%=1 W !?6,$C(7),"Answer Yes if you wish to delete the additional text, else answer No." G YNAT

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

 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

 Q