source: FOIAVistA/tag/r/PAID-PRS/PRSATPF.m@ 1150

Last change on this file since 1150 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 808 bytes
Line 
1PRSATPF ; HISC/REL-File Exceptions ;4/21/93 08:08
2 ;;4.0;PAID;;Sep 21, 1995
3FIL ; 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)
8F1 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)=""
12EX Q
13REM ; 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
Note: See TracBrowser for help on using the repository browser.