| [613] | 1 | PRSATPF ; HISC/REL-File Exceptions ;4/21/93 08:08
|
|---|
| 2 | ;;4.0;PAID;;Sep 21, 1995
|
|---|
| 3 | FIL ; File Exception
|
|---|
| 4 | S ESTR=DFN_"^"_X1_"^"_$P(X2,"^",2)_"^"_$P(X2,"^",1)
|
|---|
| 5 | ; First, check if duplicate
|
|---|
| 6 | F DA=0:0 S DA=$O(^PRST(458.5,"C",DFN,DA)) Q:DA<1 I $P($G(^PRST(458.5,DA,0)),"^",2,5)=ESTR G EX
|
|---|
| 7 | L +^PRST(458.5,0)
|
|---|
| 8 | F1 S DA=$P(^PRST(458.5,0),"^",3)+1 I $D(^PRST(458.5,DA)) S $P(^PRST(458.5,0),"^",3)=DA G F1
|
|---|
| 9 | S X=^PRST(458.5,0),$P(X,"^",3)=DA,$P(X,"^",4)=$P(X,"^",4)+1,^PRST(458.5,0)=X L -^PRST(458.5,0)
|
|---|
| 10 | S ^PRST(458.5,DA,0)=DA_"^"_ESTR
|
|---|
| 11 | S ^PRST(458.5,"B",DA,DA)="",^PRST(458.5,"C",DFN,DA)=""
|
|---|
| 12 | EX Q
|
|---|
| 13 | REM ; Remove Exception
|
|---|
| 14 | L +^PRST(458.5,0)
|
|---|
| 15 | S X=^PRST(458.5,0) S:$P(X,"^",3)=DA $P(X,"^",3)=DA-1 S $P(X,"^",4)=$P(X,"^",4)-1
|
|---|
| 16 | K ^PRST(458.5,"C",DFN,DA),^PRST(458.5,"B",DA,DA),^PRST(458.5,DA)
|
|---|
| 17 | S ^PRST(458.5,0)=X L -^PRST(458.5,0) Q
|
|---|
