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