LRURG.m

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 ---LRURG   498     printed  Apr 09, 2024@21:06:23                                                                                                                                                                                                        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