source: WorldVistAEHR/trunk/r/GEN_MED_REC_GENERATOR-GMRG/GMRGED5.m@ 1714

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

initial load of WorldVistAEHR

File size: 3.1 KB
Line 
1GMRGED5 ;CISC/RM-PATIENT DATA EDIT (cont.) ;4/25/89
2 ;;3.0;Text Generator;;Jan 24, 1996
3APPEND ; 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")
7SAT 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
10APPR ;
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
14APTXED ;
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
17YNAP 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
19APTX0 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
22ADDITION ;
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:"")
26EDTX 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
29YNAT 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
31STDAT 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
Note: See TracBrowser for help on using the repository browser.