| 1 | RMPREOPS ;HINES-IO/HNC -POST INIT ;2-29-00
|
|---|
| 2 | ;;3.0;PROSTHETICS;**45**;Feb 09, 1996
|
|---|
| 3 | ;post init, set all to manual if no type
|
|---|
| 4 | ;set manual record
|
|---|
| 5 | S BC=0
|
|---|
| 6 | F S BC=$O(^RMPR(668,BC)) Q:BC'>0 D
|
|---|
| 7 | .Q:$P(^RMPR(668,BC,0),U,8)
|
|---|
| 8 | .S $P(^RMPR(668,BC,0),U,8)=5
|
|---|
| 9 | ;set status open or closed
|
|---|
| 10 | S BC=0,STATUS=""
|
|---|
| 11 | F S BC=$O(^RMPR(668,BC)) Q:BC'>0 D
|
|---|
| 12 | .S STATUS=$P(^RMPR(668,BC,0),U,10)
|
|---|
| 13 | .I STATUS'="" Q
|
|---|
| 14 | .S CLOSED=$P(^RMPR(668,BC,0),U,5)
|
|---|
| 15 | .S $P(^RMPR(668,BC,0),U,9)=CLOSED
|
|---|
| 16 | .I (CLOSED'="")&('$D(^RMPR(668,BC,4))) S ^RMPR(668,BC,4,0)="^668.012^1^1^"_DT_"^^"
|
|---|
| 17 | .I CLOSED'="" S $P(^RMPR(668,BC,0),U,10)="C"
|
|---|
| 18 | .I CLOSED="" S $P(^RMPR(668,BC,0),U,10)="O"
|
|---|
| 19 | .I (CLOSED'="")&('$D(^RMPR(668,BC,4,1))) S ^RMPR(668,BC,4,1,0)="Old suspense record, no completion note available."
|
|---|
| 20 | .S CLBY=$P(^RMPR(668,BC,0),U,6)
|
|---|
| 21 | .S $P(^RMPR(668,BC,0),U,12)=CLBY
|
|---|
| 22 | .K CLOSED,CLBY
|
|---|
| 23 | ;set E x-ref on Status field 14
|
|---|
| 24 | S DIK="^RMPR(668,"
|
|---|
| 25 | S DIK(1)="14^E"
|
|---|
| 26 | D ENALL^DIK
|
|---|
| 27 | Q
|
|---|
| 28 | ;
|
|---|
| 29 | ;END
|
|---|
