Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: GMRGED1

GMRGED1.m

Go to the documentation of this file.
GMRGED1 ;HIRMFO/RM-PATIENT DATA EDIT (cont.) ;9/1/95
 ;;3.0;Text Generator;;Jan 24, 1996
EN1 ; ENTRY TO PRINT, CHOOSE, PROCESS SELECTIONS FOR THE AGGY TERM
 ; IDENTIFIED IN GMRGTERM
 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
REP S GMRGDN=0 F GMRGSLY(0)=1:1 D REPRINT^GMRGEDB Q:GMRGOUT!GMRGDN!GMRGJUMP
 Q:GMRGOUT  ;S:$D(XRT0) XRTN=$T(+0) D:$D(XRT0) T1^%ZOSV ; STOP RT
 S GMRGREP=0 D:'GMRGJUMP SEL G:GMRGREP REP ;D:$D(XRTL)&'GMRGOUT T0^%ZOSV ; START RT
 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
 Q
SEL S (GMRGPSEL,GMRGUP)=0 W !! D PROMPT^GMRGED3 R GMRGS:DTIME
 S:GMRGS="^"!(GMRGS="^^")!'$T GMRGOUT=1 S:GMRGS=""&'$O(GMRGUSL(0)) GMRGUP=1
 Q:GMRGUP!GMRGOUT
PSEL 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
 I GMRGS="^R"!(GMRGS="^r") S GMRGSTAR=GMRGSTAR(0,GMRGSTAR(2)) Q:GMRGPSEL  D REPRINT^GMRGEDB Q:GMRGOUT  G SEL
 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
 I GMRGS="-" S GMRGSTAR(2)=GMRGSTAR(2)-1,GMRGREP=1,GMRGSTAR=GMRGSTAR(0,GMRGSTAR(2)) Q
 I GMRGS?3"?".E D PRTDEF^GMRGED4 Q:GMRGOUT  S GMRGSTAR=GMRGSTAR(0,GMRGSTAR(2)) Q:GMRGPSEL  D REPRINT^GMRGEDB Q:GMRGOUT  G SEL
 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
 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
 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
 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
 ; THE FOLLOWING CODE HAS BEEN COMMENTED OUT BECAUSE JUMPING AND
 ; SCRIPTING HAVE BEEN PULLED BACK FROM V3.  HOWEVER, THEY MAY BE
 ; UNCOMMENTED IN A PATCH, AND SO THEY ARE LEFT IN THE ROUTINE.
 ;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
 ;I GMRGS?1"[".E D FNDTMP^GMRGEDB S:'GMRGOUT&$D(GMRGUSL) GMRGJUMP=1 S:'GMRGJUMP GMRGSTAR=GMRGSTAR(0,GMRGSTAR(2)),GMRGREP=GMRGREP+1 Q
 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
 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)
 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
 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,"."
 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."
 I  S GMRGSTAR=GMRGSTAR(0,GMRGSTAR(2)),GMRGOOD=0,GMRGMSR=1,GMRG1=GMRGSTAR(1) Q:GMRGPSEL  G SEL
 S GMRGQ="",GMRG1=GMRGSTAR(1) F GMRGQ(0)=0:0 S GMRGQ=$O(GMRGQUSL(GMRGQ)) Q:GMRGQ=""  S GMRGUSL(GMRGQ)=GMRGQUSL(GMRGQ)
 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
 Q