source: WorldVistAEHR/trunk/r/GEN_MED_REC_GENERATOR-GMRG/GMRGED4.m@ 1582

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

initial load of WorldVistAEHR

File size: 3.1 KB
Line 
1GMRGED4 ;CISC/RM-PATIENT DATA EDIT (cont.) ;3/16/89
2 ;;3.0;Text Generator;;Jan 24, 1996
3PRTDEF ; PRINT TERM DEFINITION OF ALL TERMS ON THIS SCREEN
4 W ! S GMRG02=0 F GMRG00=GMRGSTAR(0,GMRGSTAR(2)):0 S GMRG00=$O(GMRGSEL(GMRG00)) Q:GMRG00'>0!(GMRG00>GMRGSTAR(1)) S GMRG01=$P(GMRGSEL(GMRG00),"^") D PRTD1 Q:GMRGOUT
5 I GMRGOUT S:GMRGOUT=1 GMRGOUT=0 Q
6 W !,"Press return to continue " R X:DTIME I X="^"!(X="^^")!'$T S GMRGOUT=1
7 Q
8PRTD1 ;
9 I GMRG02>(IOSL-3) S GMRG02=0 W !,"Press return to continue " R X:DTIME S:X="^^"!(X="^")!'$T GMRGOUT=$S(X="^":1,1:2) Q:GMRGOUT
10 W !,"'" S GMRGXPRT=$P(GMRGSEL(GMRG00),"^",2),GMRGXPRT(0)=$S($D(GMRGSEL(GMRG00,1)):$P(GMRGSEL(GMRG00,1),"^",2),1:"") D EN1^GMRGRUT2 W "'" S GMRG02=GMRG02+2
11 K ^UTILITY($J,"W") F GMRG03=0:0 S GMRG03=$O(^GMRD(124.2,GMRG01,"TD",GMRG03)) Q:GMRG03'>0 S X=$S($D(^(GMRG03,0)):^(0),1:""),DIWL=5,DIWR=IOM,DIWF="W",GMRG02=GMRG02+1 D ^DIWP
12 D ^DIWW S GMRG02=GMRG02+1 K DIWL,DIWR,DIWF,^UTILITY($J,"W")
13 Q
14PRAD ; PRINT ADDITIONAL TEXT
15 S GMRGPLN=$S(+$P(GMRGTERM,"^",3)'>0:"",$D(^GMR(124.3,GMRGPDA,1,$P(GMRGTERM,"^",3),"ADD")):^("ADD"),1:""),GMRGL=IOM-22,GMRGLEN=GMRGL,GMRGLIN=GMRGLIN+1 D FITLINE^GMRGRUT1 W GMRGPLN(0)
16 F GMRG1=0:0 Q:GMRGPLN(1)="" S GMRGLEN=GMRGL,GMRGPLN=GMRGPLN(1) D FITLINE^GMRGRUT1 W !?22,GMRGPLN(0) S GMRGLIN=GMRGLIN+1 I GMRGLIN>(IOSL-4) S GMRGLIN=0 W !,"'^' TO STOP: " R X:DTIME S GMRGOUT=$S(X="^":1,X="^^"!'$T:2,1:GMRGOUT) Q:GMRGOUT
17 Q
18SETSEL ; SET GMRGSEL ARRAY
19 F GMRG1=0:0 S GMRG1=$O(^GMR(124.3,GMRGPDA,1,"ALIST",$P(GMRGTERM,"^"),GMRG1)) Q:GMRG1'>0 S GMRGPAT(GMRG1)=^(GMRG1)
20 K GMRGSEL S GMRGUP=0,GMRGCNT=1,GMRG2="" F GMRG2(0)=0:0 S GMRG2=$O(^GMRD(124.2,$P(GMRGTERM,"^"),1,"AC",GMRG2)) Q:GMRG2="" F GMRG1=0:0 S GMRG1=$O(^GMRD(124.2,$P(GMRGTERM,"^"),1,"AC",GMRG2,GMRG1)) Q:GMRG1'>0 D PRTSEL
21 I $P(GMRGTERM(0),"^",10) D EN1^GMRGED8 ; save for split screen
22 I $P(GMRGTERM(0),"^",11) D EN2^GMRGED9
23 Q
24PRTSEL ; SET UP THE GMRGSEL ARRAY OF SELECTIONS OF THIS TERM.
25 S GMRGSEL=$S($D(^GMRD(124.2,$P(GMRGTERM,"^"),1,GMRG1,0)):$P(^(0),"^",1,2),1:""),GMRGND=$P(GMRGSEL,"^") Q:GMRGND="" D PATDAT^GMRGRUT2 S GMRGSEL(GMRGCNT)=GMRGSEL_"^"_GMRGPRT S:GMRGPRT GMRGSEL(GMRGCNT,1)=GMRGPRT(0) S GMRGCNT=GMRGCNT+1
26 Q
27REPRT ;
28 S GMRGPRT=$P(GMRGSEL(GMRG1),"^",3),GMRGSEL=GMRGSEL(GMRG1),GMRGPRT(0)=$S($D(GMRGSEL(GMRG1,1)):GMRGSEL(GMRG1,1),1:""),GMRGSTAR=GMRG1-1 Q:GMRGOUT I GMRGLIN>(IOSL-4) S GMRGLIN=0 D PARSEL Q
29 S GMRGLIN=GMRGLIN+1 W !,$S(GMRGPRT:"**",1:""),?4,$S('$D(^GMRD(124.2,"ATY",3,$P(GMRGSEL,"^"))):"+",1:" "),$J((GMRG1),2),". "
30 S GMRGXPRT=$P(GMRGSEL,"^",2),GMRGXPRT(0)=$P(GMRGPRT(0),"^",2),GMRGXPRT(1)="9^"_IOM_"^1^"_$S(GMRGPRT&GMRGIO("S")&'$P(GMRGSITE(0),"^",2):1,1:0)_"^" D EN1^GMRGRUT2
31 S GMRGTLC=$Y
32 K GMRGHPRT I $D(^GMRD(124.2,$P(GMRGSEL,"^"),10)) X ^(10)
33 F X=0:0 S X=$O(GMRGHPRT(X)) Q:X'>0 W ?(+GMRGHPRT(X)),$P(GMRGHPRT(X),"^",2)
34 S GMRGTLC=$Y-GMRGTLC I GMRGTLC>0 S GMRGLIN=GMRGLIN+GMRGTLC
35 Q
36PARSEL ;
37 W !!,"Please make the appropriate selections from this screen before continuing onto",!,"the next screen. " D PROMPT^GMRGED3 R GMRGS:DTIME
38 S:GMRGS="^"!(GMRGS="^^")!'$T GMRGOUT=1 Q:GMRGOUT S GMRGSTAR(1)=GMRG1,GMRGPSEL=1 D PSEL^GMRGED1 I 'GMRGOOD G:GMRGMSR PARSEL Q
39 S GMRGSTAR(2)=GMRGSTAR(2)+1,GMRGSTAR=GMRGSTAR(1)-1
40 Q
Note: See TracBrowser for help on using the repository browser.