- 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 Jan 18, 2025@03:35:11 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 ;