source: WorldVistAEHR/trunk/r/GEN_MED_REC_GENERATOR-GMRG/GMRGED1.m@ 1605

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

initial load of WorldVistAEHR
File size: 4.0 KB
RevLine 
[613]1GMRGED1 ;HIRMFO/RM-PATIENT DATA EDIT (cont.) ;9/1/95
2 ;;3.0;Text Generator;;Jan 24, 1996
3EN1 ; ENTRY TO PRINT, CHOOSE, PROCESS SELECTIONS FOR THE AGGY TERM
4 ; IDENTIFIED IN GMRGTERM
5 K GMRGUSL,GMRGSTAR,GMRGHPRT D SETSEL^GMRGED4 S GMRGMAX=$S($P(GMRGTERM(0),"^",7):$P(GMRGTERM(0),"^",7),1:99),GMRGSEL=GMRGCNT-1,(GMRGSTAR(0,1),GMRGSTAR,GMRGJUMP)=0,GMRGSTAR(2)=1
6REP S GMRGDN=0 F GMRGSLY(0)=1:1 D REPRINT^GMRGEDB Q:GMRGOUT!GMRGDN!GMRGJUMP
7 Q:GMRGOUT ;S:$D(XRT0) XRTN=$T(+0) D:$D(XRT0) T1^%ZOSV ; STOP RT
8 S GMRGREP=0 D:'GMRGJUMP SEL G:GMRGREP REP ;D:$D(XRTL)&'GMRGOUT T0^%ZOSV ; START RT
9 Q:GMRGOUT!GMRGUP D EN1^GMRGED2 S GMRGUP=$S(GMRGNORD#2:1,1:0) G EN1:'GMRGOUT&'GMRGUP D SETSEL^GMRGED4 S GMRGUP=GMRGNORD#2
10 Q
11SEL S (GMRGPSEL,GMRGUP)=0 W !! D PROMPT^GMRGED3 R GMRGS:DTIME
12 S:GMRGS="^"!(GMRGS="^^")!'$T GMRGOUT=1 S:GMRGS=""&'$O(GMRGUSL(0)) GMRGUP=1
13 Q:GMRGUP!GMRGOUT
14PSEL S (GMRGMSR,GMRGOOD)=0 K GMRGQUSL I GMRGS'?3"?".E,GMRGS?1"?".E S XQH=$S(GMRGS?1"??".E:"GMRG-COMPLETE SELECTION HELP",1:"GMRG-SELECTIONS") D EN^XQH K XQH S GMRGSTAR=GMRGSTAR(0,GMRGSTAR(2)) Q:GMRGPSEL D REPRINT^GMRGEDB Q:GMRGOUT G SEL
15 I GMRGS="^R"!(GMRGS="^r") S GMRGSTAR=GMRGSTAR(0,GMRGSTAR(2)) Q:GMRGPSEL D REPRINT^GMRGEDB Q:GMRGOUT G SEL
16 I GMRGS="-",GMRGSTAR(2)'>1&'GMRGPSEL!(GMRGSTAR(2)=1) W !!,$C(7),"There is no previous screen of selections." G:GMRGSTAR(2)'>1&'GMRGPSEL SEL S GMRGMSR=1,GMRGSTAR=GMRGSTAR(0,GMRGSTAR(2)) Q
17 I GMRGS="-" S GMRGSTAR(2)=GMRGSTAR(2)-1,GMRGREP=1,GMRGSTAR=GMRGSTAR(0,GMRGSTAR(2)) Q
18 I GMRGS?3"?".E D PRTDEF^GMRGED4 Q:GMRGOUT S GMRGSTAR=GMRGSTAR(0,GMRGSTAR(2)) Q:GMRGPSEL D REPRINT^GMRGEDB Q:GMRGOUT G SEL
19 I GMRGS="^D"!(GMRGS="^d") D DEMPAT^GMRGRUT2 Q:GMRGOUT S GMRGSTAR=GMRGSTAR(0,GMRGSTAR(2)) Q:GMRGPSEL D REPRINT^GMRGEDB Q:GMRGOUT G SEL
20 I GMRGS="^P"!(GMRGS="^p") D NOW^%DTC S GMRGPDT=%,GMRGPROU="D "_$S(GMRGSITE("P")'="":GMRGSITE("P"),1:"EN1^GMRGPUTL") X GMRGPROU Q:GMRGOUT S GMRGSTAR=GMRGSTAR(0,GMRGSTAR(2)) Q:GMRGPSEL D REPRINT^GMRGEDB Q:GMRGOUT G SEL
21 I GMRGS="^T"!(GMRGS="^t") S GMRGTOP=1-GMRGTOP W !!,"The narrative display is ",$S(GMRGTOP:"on",1:"off"),".",!!,"Press return to continue " R X:DTIME S:X="^"!(X="^^")!'$T GMRGOUT=1 S GMRGSTAR=GMRGSTAR(0,GMRGSTAR(2)) Q:GMRGOUT!GMRGPSEL G SEL
22 I GMRGS="^H"!(GMRGS="^h") D EN1^GMRGRUT4,EN2^GMRGRUT4 S GMRGSTAR=GMRGSTAR(0,GMRGSTAR(2)) Q:GMRGPSEL D REPRINT^GMRGEDB Q:GMRGOUT G SEL
23 ; THE FOLLOWING CODE HAS BEEN COMMENTED OUT BECAUSE JUMPING AND
24 ; SCRIPTING HAVE BEEN PULLED BACK FROM V3. HOWEVER, THEY MAY BE
25 ; UNCOMMENTED IN A PATCH, AND SO THEY ARE LEFT IN THE ROUTINE.
26 ;I GMRGS?1"^^".E,GMRGS'?1"^^^".E D JUMP^GMRGEDA S:'GMRGOUT&$D(GMRGUSL) GMRGJUMP=1 S:'GMRGJUMP GMRGSTAR=GMRGSTAR(0,GMRGSTAR(2)),GMRGREP=GMRGREP+1 Q
27 ;I GMRGS?1"[".E D FNDTMP^GMRGEDB S:'GMRGOUT&$D(GMRGUSL) GMRGJUMP=1 S:'GMRGJUMP GMRGSTAR=GMRGSTAR(0,GMRGSTAR(2)),GMRGREP=GMRGREP+1 Q
28 S GMRGOOD=1 D VALIDATE^GMRGED3 I 'GMRGOOD W !?5,$C(7),"Please enter a valid list of selections,",!?5,"type '?' or '??' if you need more help." S GMRGSTAR=GMRGSTAR(0,GMRGSTAR(2)),GMRGMSR=1,GMRG1=GMRGSTAR(1) Q:GMRGPSEL G SEL
29 S GMRG2=$S($D(GMRGUSL("A"))!$D(GMRGQUSL("A")):1,'$D(^GMR(124.3,GMRGPDA,1,+$P(GMRGPRC(0),"^",2),"ADD")):0,$P(^("ADD"),"^")="":0,1:1)
30 F GMRG1=0:0 S GMRG1=$O(GMRGSEL(GMRG1)) Q:GMRG1'>0 I $S('$D(GMRGQUSL(GMRG1))&'$D(GMRGUSL(GMRG1)):$S($P(GMRGSEL(GMRG1),"^",3)=1:1,1:0),$D(GMRGQUSL(GMRG1)):$S(GMRGQUSL(GMRG1)'="@":1,1:0),GMRGUSL(GMRG1)'="@":1,1:0) S GMRG2=GMRG2+1
31 I GMRG2>GMRGMAX W:$P(GMRGTERM(0),"^",12)'>1 !?3,$C(7),"THE MAXIMUM NUMBER OF SELECTIONS YOU CAN HAVE FOR THIS TERM IS ",GMRGMAX,"."
32 I W:$P(GMRGTERM(0),"^",12)'>1 !?3,"YOU HAVE EXCEEDED THIS MAXIMUM BY ",GMRG2-GMRGMAX," SELECTION"_$E("S",1,GMRG2-GMRGMAX-1)_", PLEASE CORRECT."
33 I S GMRGSTAR=GMRGSTAR(0,GMRGSTAR(2)),GMRGOOD=0,GMRGMSR=1,GMRG1=GMRGSTAR(1) Q:GMRGPSEL G SEL
34 S GMRGQ="",GMRG1=GMRGSTAR(1) F GMRGQ(0)=0:0 S GMRGQ=$O(GMRGQUSL(GMRGQ)) Q:GMRGQ="" S GMRGUSL(GMRGQ)=GMRGQUSL(GMRGQ)
35 I GMRGS[",",$P(GMRGS,",",$L(GMRGS,","))="" S X=$P(^TMP($J,"GMRGLVL",+GMRGLVL,+GMRGLVL(+GMRGLVL),+GMRGLVL(+GMRGLVL,+GMRGLVL(+GMRGLVL))),"^",3),$P(^(+GMRGLVL(+GMRGLVL,+GMRGLVL(+GMRGLVL))),"^",3)=(X\10)_1
36 Q
Note: See TracBrowser for help on using the repository browser.