source: WorldVistAEHR/trunk/r/RECORD_TRACKING-RT/RTL3.m@ 1154

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

initial load of WorldVistAEHR

File size: 1.2 KB
RevLine 
[613]1RTL3 ;JSM/TROY ISC;Label Print Fields Utility; ; 1/30/87 10:09 AM ;
2 ;;v 2.0;Record Tracking;;10/22/91
3 ;Called from the Mumps Code To Set Variable field of 194.5
4 ;expects: RT0 = entity record#;entity global name^...
5 ; RTJ = label print field internal # in 194.5
6 ;looks at parent file multiple in 194.5 to get global;piece
7 ;outputs: @RTVARNAM = print field value
8 S RTVP=$P(RT0,"^") G VAR
9EN ;enter here for BORROWER variable pointer fields with RTQ as zeroth node
10 ;of request file (190.1)
11 S RTVP=$P(RTQ,"^",5)
12VAR S RTVARNAM=$P(^DIC(194.5,RTJ,0),U,5) G Q:RTVARNAM'?1"RTV("1N.N1")" S @RTVARNAM="Unknown"
13 S RTG=$P(RTVP,";",2),RTDA=+RTVP G Q:RTG']""
14 I @("$D(^"_RTG_"0))#10") S RTFN=+$P(^(0),"^",2) G Q:'$D(^DIC(194.5,RTJ,50,RTFN)) S RTGP=$P(^(RTFN,0),"^",3),RTGP1=$P(RTGP,";"),RTGP2=$P(RTGP,";",2)
15 G Q:$S('$D(RTFN):1,'$D(RTGP1):1,'$D(RTGP2):1,RTGP1']"":1,RTGP2']"":1,1:0)
16 S RTGP1=""""_RTGP1_"""" I @("'$D(^"_RTG_RTDA_","_RTGP1_"))#10") Q
17 S Y=@("^"_RTG_RTDA_","_RTGP1_")"),Y=$S(+RTGP2:$P(Y,"^",RTGP2),1:$E(Y,$E($P(RTGP2,",",1),2,99),$P(RTGP2,",",2))),C=$P(^DD(RTFN,+$P(^DIC(194.5,RTJ,50,RTFN,0),"^",2),0),"^",2) D Y^DIQ S @RTVARNAM=Y
18Q K Y,C,RTVP,RTGP1,RTGP2,RTGP,RTG,RTDA,RTFN,RTVARNAM Q
Note: See TracBrowser for help on using the repository browser.