LRURG ;AVAMC/REG - TRANSFER ROUTINES ;5/30/96 13:22 ;
;;5.2;LAB SERVICE;**72**;Sep 27, 1994
W !!,"Transfer routines",!
X ^%ZOSF("RSEL") D ^%ZIS
EN S U="^",X="N",%DT="T" D ^%DT X ^DD("DD") S %DT=Y
S A=0,L=$P($T(L),";",3,99),PR=$P($T(PR),";",3,99)
H 5 W "Transferred Routines",!,%DT
X X "F I=0:1 S A=$O(^TMP($J,A)) Q:A="""" ZL @A X L,PR"
W !! K A,I,L,LC,PR,S,X,Y Q
;
L ;;W:I ! W !,A S S=0 F LC=1:1 S S=S+$L($T(+LC)) I $T(+LC)="" S LC=LC-1 Q
PR ;;F I=1:1 S X=$T(+I) Q:X="" W !,X
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRURG 498 printed Dec 13, 2024@02:22:06 Page 2
LRURG ;AVAMC/REG - TRANSFER ROUTINES ;5/30/96 13:22 ;
+1 ;;5.2;LAB SERVICE;**72**;Sep 27, 1994
+2 WRITE !!,"Transfer routines",!
+3 XECUTE ^%ZOSF("RSEL")
DO ^%ZIS
EN SET U="^"
SET X="N"
SET %DT="T"
DO ^%DT
XECUTE ^DD("DD")
SET %DT=Y
+1 SET A=0
SET L=$PIECE($TEXT(L),";",3,99)
SET PR=$PIECE($TEXT(PR),";",3,99)
+2 HANG 5
WRITE "Transferred Routines",!,%DT
X XECUTE "F I=0:1 S A=$O(^TMP($J,A)) Q:A="""" ZL @A X L,PR"
+1 WRITE !!
KILL A,I,L,LC,PR,S,X,Y
QUIT
+2 ;
L ;;W:I ! W !,A S S=0 F LC=1:1 S S=S+$L($T(+LC)) I $T(+LC)="" S LC=LC-1 Q
PR ;;F I=1:1 S X=$T(+I) Q:X="" W !,X
