RTM ;PKE/ISC-ALBANY;Record Maintenance Option ; ; 9/10/90 14:24 ;
;;v 2.0;Record Tracking;;10/22/91
D DT^DICRW S X=$T(+1),DIK="^DOPT("""_$P(X," ;",1)_"""," G:$D(^DOPT($P(X," ;"),10)) A S ^DOPT($P(X," ;"),0)=$P(X,";",3)_"^1N^" F I=1:1 S Y=$T(@I) Q:Y="" S ^DOPT($P(X," ;"),I,0)=$P(Y,";",3,99)
D IXALL^DIK
A D OVERALL^RTPSET Q:$D(XQUIT) W !! S DIC="^DOPT("""_$P($T(+1)," ;")_""",",DIC(0)="IQEAMZ" D ^DIC Q:Y<0 D @+Y G A
;
1 ;;Generate Record Retirement Pull lists
G ^RTSM8
;
2 ;;Print Record Retirement Pull Lists
S RTIRE="" D ^RTP3 K RTIRE Q
;
3 ;;Designate Non-fillables
G 5^RTP1
;
4 ;;Delete a Record
G ^RTDEL
;
5 ;;Create a Perpetual Record/Volume
G ^RTDPA1
;
6 ;;Charge out/transfer Record Retirement lists
S RTIRE="" D ^RTP4 K RTIRE Q
;
7 ;;[not used]
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRTM 805 printed Oct 16, 2024@18:34:45 Page 2
RTM ;PKE/ISC-ALBANY;Record Maintenance Option ; ; 9/10/90 14:24 ;
+1 ;;v 2.0;Record Tracking;;10/22/91
+2 DO DT^DICRW
SET X=$TEXT(+1)
SET DIK="^DOPT("""_$PIECE(X," ;",1)_""","
if $DATA(^DOPT($PIECE(X," ;"),10))
GOTO A
SET ^DOPT($PIECE(X," ;"),0)=$PIECE(X,";",3)_"^1N^"
FOR I=1:1
SET Y=$TEXT(@I)
if Y=""
QUIT
SET ^DOPT($PIECE(X," ;"),I,0)=$PIECE(Y,";",3,99)
+3 DO IXALL^DIK
A DO OVERALL^RTPSET
if $DATA(XQUIT)
QUIT
WRITE !!
SET DIC="^DOPT("""_$PIECE($TEXT(+1)," ;")_""","
SET DIC(0)="IQEAMZ"
DO ^DIC
if Y<0
QUIT
DO @+Y
GOTO A
+1 ;
1 ;;Generate Record Retirement Pull lists
+1 GOTO ^RTSM8
+2 ;
2 ;;Print Record Retirement Pull Lists
+1 SET RTIRE=""
DO ^RTP3
KILL RTIRE
QUIT
+2 ;
3 ;;Designate Non-fillables
+1 GOTO 5^RTP1
+2 ;
4 ;;Delete a Record
+1 GOTO ^RTDEL
+2 ;
5 ;;Create a Perpetual Record/Volume
+1 GOTO ^RTDPA1
+2 ;
6 ;;Charge out/transfer Record Retirement lists
+1 SET RTIRE=""
DO ^RTP4
KILL RTIRE
QUIT
+2 ;
7 ;;[not used]
+1 ;
