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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRGED5 3189 printed Oct 16, 2024@17:55:59 Page 2
GMRGED5 ;CISC/RM-PATIENT DATA EDIT (cont.) ;4/25/89
+1 ;;3.0;Text Generator;;Jan 24, 1996
APPEND ; EDIT APPENDED TEXT FOR THE SELECTED ENTRY.
+1 SET (GMRGTX("OL"),GMRGTX)=$PIECE(GMRGPRC(0),"^",3)
SET GMRGTX("ACTION")=$PIECE($PIECE($PIECE(GMRGPRC,"^",2),"/"),";",2,99)
+2 IF GMRGTX("ACTION")=""
DO APPR
+3 IF GMRGTX("ACTION")'=""
SET $PIECE(GMRGTX,"|")=GMRGTX("ACTION")
SAT IF 'GMRGOUT
IF GMRGTX("OL")'=GMRGTX
SET X=GMRGTX("OL")
SET DA=$PIECE(GMRGPRC(0),"^",2)
SET DA(1)=GMRGPDA
SET GMRGY=2
SET GMRGAT=0
SET GMRGZ=""
DO EN1^GMRGUTL
KILL GMRGAT,GMRGZ
SET $PIECE(^GMR(124.3,DA(1),1,DA,0),"^",2)=GMRGTX
SET $PIECE(GMRGPRC(0),"^",3)=GMRGTX
+1 IF 'GMRGOUT
IF GMRGTX("OL")'=GMRGTX
SET ^TMP($JOB,"GMRGLVL",$PIECE(GMRGLVL,"^"),GMRGTLVL,GMRGSLVL,0)=GMRGPRC(0)
+2 QUIT
APPR ;
+1 WRITE !!,"APPENDED TEXT for '"
SET GMRGXPRT(0)=$PIECE(GMRGPRC(0),"^",3)
SET GMRGXPRT=$PIECE(GMRGPRC(0),"^")
SET GMRGXPRT(1)="19^"_(IOM)_"^1^0"
DO EN1^GMRGRUT2
WRITE "'"
+2 SET (GMRGTX("OLD"),GMRGTX(0))=$PIECE(GMRGTX,"|")
DO APTXED
SET $PIECE(GMRGTX,"|")=GMRGTX(0)
+3 QUIT
APTXED ;
+1 IF $LENGTH(GMRGTX(0))>15
SET GMRGTX("@")=1
SET GMRGTX(1)=0
WRITE !
DO EN1^GMRGED3
GOTO APTX0
+2 WRITE !,"Appended Text: ",$SELECT($LENGTH(GMRGTX(0)):GMRGTX(0)_"// ",1:"")
READ GMRGTX(0):DTIME
if GMRGTX(0)=""&$LENGTH(GMRGTX("OLD"))
SET GMRGTX(0)=GMRGTX("OLD")
if GMRGTX(0)="^"!(GMRGTX(0)="^^")!'$TEST
SET GMRGOUT=1
if GMRGOUT!(GMRGTX(0)="")
QUIT
if GMRGTX(0)'="@"
GOTO APTX0
YNAP WRITE !?4,$CHAR(7),"WANT TO DELETE"
SET %=1
DO YN^DICN
if %=-1
SET GMRGOUT=1
if GMRGOUT
QUIT
if %=2
WRITE $CHAR(7)," ??"
SET GMRGTX(0)=$SELECT(%=2:GMRGTX("OLD"),%=1:"",1:GMRGTX(0))
+1 if %=2
GOTO APTXED
if %=1
GOTO APTX0
WRITE !?8,$CHAR(7),"Answer Yes if you want to delete the appended text, else answer No"
GOTO YNAP
APTX0 IF $LENGTH((GMRGTX(0)_"|"_$PIECE(GMRGTX,"|",2,$LENGTH(GMRGTX,"|"))))>175
WRITE !?4,$CHAR(7),"LINE TOO LONG??"
SET GMRGTX(0)=GMRGTX("OLD")
GOTO APTXED
+1 IF GMRGTX(0)["^"!(GMRGTX(0)?1"?".E)
WRITE !?4,$CHAR(7),$SELECT(GMRGTX(0)?1"?".E:"ANSWER WITH FREE TEXT",1:"ANSWER CANNOT CONTAIN THE CIRCUMFLEX '^' CHARACTER")
SET GMRGTX(0)=GMRGTX("OLD")
GOTO APTXED
+2 QUIT
ADDITION ;
+1 IF '$PIECE(GMRGTERM(0),"^",9)
WRITE !,$CHAR(7),"CANNOT EDIT ADDITIONAL TEXT??"
READ !,"Press return to continue ",X:DTIME
if X="^"!(X="^^")!'$TEST
SET GMRGOUT=1
QUIT
+2 WRITE !!,"ADDITIONAL TEXT",!,$EXTRACT(GMRGLIN("*"),1,15)
+3 SET (GMRGTX,GMRGTX("OL"))=$SELECT($PIECE(GMRGPRC,"^",4)="":"",$DATA(^GMR(124.3,GMRGPDA,1,$PIECE(GMRGPRC,"^",4),"ADD")):^("ADD"),1:"")
EDTX WRITE !!,"Additional Text for "
SET GMRGXPRT=$PIECE(GMRGPRC,"^",3)
SET GMRGXPRT(0)=$SELECT($PIECE(GMRGPRC,"^",4)="":"",$DATA(^GMR(124.3,GMRGPDA,1,$PIECE(GMRGPRC,"^",4),0)):$PIECE(^(0),"^",2),1:"")
SET GMRGXPRT(1)="20^"_IOM_"^1"
DO EN1^GMRGRUT2
+1 IF $LENGTH(GMRGTX)>15
SET GMRGTX("@")=1
SET GMRGTX(1)=0
SET GMRGTX(0)=GMRGTX
DO EN1^GMRGED3
SET GMRGTX=GMRGTX(0)
GOTO STDAT
+2 WRITE ": ",$SELECT($LENGTH(GMRGTX):GMRGTX_"// ",1:"")
READ GMRGTX:DTIME
if GMRGTX=""&$LENGTH(GMRGTX("OL"))
SET GMRGTX=GMRGTX("OL")
if GMRGTX="^"!(GMRGTX="^^")!'$TEST
SET GMRGOUT=1
if GMRGTX=""!GMRGOUT
QUIT
if GMRGTX'="@"
GOTO STDAT
YNAT WRITE !?4,$CHAR(7),"WANT TO DELETE"
SET %=1
DO YN^DICN
if %=-1
SET GMRGOUT=1
if GMRGOUT
QUIT
if %=2
WRITE $CHAR(7)," ??"
SET GMRGTX=$SELECT(%=2:GMRGTX("OL"),%=1:"",1:GMRGTX)
+1 if %=2
GOTO EDTX
if %=1
GOTO STDAT
WRITE !?6,$CHAR(7),"Answer Yes if you wish to delete the additional text, else answer No."
GOTO YNAT
STDAT IF $LENGTH(GMRGTX)
IF ($LENGTH(GMRGTX)<1!($LENGTH(GMRGTX)>245)!(GMRGTX?1P.E))
WRITE !,$CHAR(7),"ANSWER MUST BE 1-245 CHARACTERS IN LENGTH"
SET GMRGTX=GMRGTX("OL")
GOTO EDTX
+1 IF GMRGTX("OL")'=GMRGTX
SET X=GMRGTX("OL")
SET DA=$PIECE(GMRGPRC,"^",4)
SET DA(1)=GMRGPDA
SET GMRGY=2
SET GMRGAT=1
SET GMRGZ=""
DO EN1^GMRGUTL
SET ^GMR(124.3,DA(1),1,DA,"ADD")=GMRGTX
+2 QUIT
