RMPREOPS.m

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 ---RMPREOPS   954     printed  Apr 09, 2024@21:36:11                                                                                                                                                                                                     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