RTL3 ;JSM/TROY ISC;Label Print Fields Utility; ; 1/30/87 10:09 AM ;
;;v 2.0;Record Tracking;;10/22/91
;Called from the Mumps Code To Set Variable field of 194.5
;expects: RT0 = entity record#;entity global name^...
; RTJ = label print field internal # in 194.5
;looks at parent file multiple in 194.5 to get global;piece
;outputs: @RTVARNAM = print field value
S RTVP=$P(RT0,"^") G VAR
EN ;enter here for BORROWER variable pointer fields with RTQ as zeroth node
;of request file (190.1)
S RTVP=$P(RTQ,"^",5)
VAR S RTVARNAM=$P(^DIC(194.5,RTJ,0),U,5) G Q:RTVARNAM'?1"RTV("1N.N1")" S @RTVARNAM="Unknown"
S RTG=$P(RTVP,";",2),RTDA=+RTVP G Q:RTG']""
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)
G Q:$S('$D(RTFN):1,'$D(RTGP1):1,'$D(RTGP2):1,RTGP1']"":1,RTGP2']"":1,1:0)
S RTGP1=""""_RTGP1_"""" I @("'$D(^"_RTG_RTDA_","_RTGP1_"))#10") Q
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
Q K Y,C,RTVP,RTGP1,RTGP2,RTGP,RTG,RTDA,RTFN,RTVARNAM Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRTL3 1225 printed Dec 13, 2024@02:33:59 Page 2
RTL3 ;JSM/TROY ISC;Label Print Fields Utility; ; 1/30/87 10:09 AM ;
+1 ;;v 2.0;Record Tracking;;10/22/91
+2 ;Called from the Mumps Code To Set Variable field of 194.5
+3 ;expects: RT0 = entity record#;entity global name^...
+4 ; RTJ = label print field internal # in 194.5
+5 ;looks at parent file multiple in 194.5 to get global;piece
+6 ;outputs: @RTVARNAM = print field value
+7 SET RTVP=$PIECE(RT0,"^")
GOTO VAR
EN ;enter here for BORROWER variable pointer fields with RTQ as zeroth node
+1 ;of request file (190.1)
+2 SET RTVP=$PIECE(RTQ,"^",5)
VAR SET RTVARNAM=$PIECE(^DIC(194.5,RTJ,0),U,5)
if RTVARNAM'?1"RTV("1N.N1")"
GOTO Q
SET @RTVARNAM="Unknown"
+1 SET RTG=$PIECE(RTVP,";",2)
SET RTDA=+RTVP
if RTG']""
GOTO Q
+2 IF @("$D(^"_RTG_"0))#10")
SET RTFN=+$PIECE(^(0),"^",2)
if '$DATA(^DIC(194.5,RTJ,50,RTFN))
GOTO Q
SET RTGP=$PIECE(^(RTFN,0),"^",3)
SET RTGP1=$PIECE(RTGP,";")
SET RTGP2=$PIECE(RTGP,";",2)
+3 if $SELECT('$DATA(RTFN):1,'$DATA(RTGP1):1,'$DATA(RTGP2):1,RTGP1']"":1,RTGP2']"":1,1:0)
GOTO Q
+4 SET RTGP1=""""_RTGP1_""""
IF @("'$D(^"_RTG_RTDA_","_RTGP1_"))#10")
QUIT
+5 SET Y=@("^"_RTG_RTDA_","_RTGP1_")")
SET Y=$SELECT(+RTGP2:$PIECE(Y,"^",RTGP2),1:$EXTRACT(Y,$EXTRACT($PIECE(RTGP2,",",1),2,99),$PIECE(RTGP2,",",2)))
SET C=$PIECE(^DD(RTFN,+$PIECE(^DIC(194.5,RTJ,50,RTFN,0),"^",2),0),"^",2)
DO Y^DIQ
SET @RTVARNAM=Y
Q KILL Y,C,RTVP,RTGP1,RTGP2,RTGP,RTG,RTDA,RTFN,RTVARNAM
QUIT
