RMPREOPS ;HINES-IO/HNC -POST INIT ;2-29-00
;;3.0;PROSTHETICS;**45**;Feb 09, 1996
;post init, set all to manual if no type
;set manual record
S BC=0
F S BC=$O(^RMPR(668,BC)) Q:BC'>0 D
.Q:$P(^RMPR(668,BC,0),U,8)
.S $P(^RMPR(668,BC,0),U,8)=5
;set status open or closed
S BC=0,STATUS=""
F S BC=$O(^RMPR(668,BC)) Q:BC'>0 D
.S STATUS=$P(^RMPR(668,BC,0),U,10)
.I STATUS'="" Q
.S CLOSED=$P(^RMPR(668,BC,0),U,5)
.S $P(^RMPR(668,BC,0),U,9)=CLOSED
.I (CLOSED'="")&('$D(^RMPR(668,BC,4))) S ^RMPR(668,BC,4,0)="^668.012^1^1^"_DT_"^^"
.I CLOSED'="" S $P(^RMPR(668,BC,0),U,10)="C"
.I CLOSED="" S $P(^RMPR(668,BC,0),U,10)="O"
.I (CLOSED'="")&('$D(^RMPR(668,BC,4,1))) S ^RMPR(668,BC,4,1,0)="Old suspense record, no completion note available."
.S CLBY=$P(^RMPR(668,BC,0),U,6)
.S $P(^RMPR(668,BC,0),U,12)=CLBY
.K CLOSED,CLBY
;set E x-ref on Status field 14
S DIK="^RMPR(668,"
S DIK(1)="14^E"
D ENALL^DIK
Q
;
;END
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRMPREOPS 954 printed Dec 13, 2024@02:34:27 Page 2
RMPREOPS ;HINES-IO/HNC -POST INIT ;2-29-00
+1 ;;3.0;PROSTHETICS;**45**;Feb 09, 1996
+2 ;post init, set all to manual if no type
+3 ;set manual record
+4 SET BC=0
+5 FOR
SET BC=$ORDER(^RMPR(668,BC))
if BC'>0
QUIT
Begin DoDot:1
+6 if $PIECE(^RMPR(668,BC,0),U,8)
QUIT
+7 SET $PIECE(^RMPR(668,BC,0),U,8)=5
End DoDot:1
+8 ;set status open or closed
+9 SET BC=0
SET STATUS=""
+10 FOR
SET BC=$ORDER(^RMPR(668,BC))
if BC'>0
QUIT
Begin DoDot:1
+11 SET STATUS=$PIECE(^RMPR(668,BC,0),U,10)
+12 IF STATUS'=""
QUIT
+13 SET CLOSED=$PIECE(^RMPR(668,BC,0),U,5)
+14 SET $PIECE(^RMPR(668,BC,0),U,9)=CLOSED
+15 IF (CLOSED'="")&('$DATA(^RMPR(668,BC,4)))
SET ^RMPR(668,BC,4,0)="^668.012^1^1^"_DT_"^^"
+16 IF CLOSED'=""
SET $PIECE(^RMPR(668,BC,0),U,10)="C"
+17 IF CLOSED=""
SET $PIECE(^RMPR(668,BC,0),U,10)="O"
+18 IF (CLOSED'="")&('$DATA(^RMPR(668,BC,4,1)))
SET ^RMPR(668,BC,4,1,0)="Old suspense record, no completion note available."
+19 SET CLBY=$PIECE(^RMPR(668,BC,0),U,6)
+20 SET $PIECE(^RMPR(668,BC,0),U,12)=CLBY
+21 KILL CLOSED,CLBY
End DoDot:1
+22 ;set E x-ref on Status field 14
+23 SET DIK="^RMPR(668,"
+24 SET DIK(1)="14^E"
+25 DO ENALL^DIK
+26 QUIT
+27 ;
+28 ;END
