- 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 Feb 18, 2025@23:47:58 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