26 lines
631 B
Mathematica
26 lines
631 B
Mathematica
PRCCL406 ;BP-OIFO/SWS-IFCAP ARCHIVE/PURGE UTILITY ROUTINE ;12/07/2005 12:16
|
|
V ;;5.1;IFCAP;**95**;Oct 20, 2000
|
|
Q
|
|
START S IPIEN=0,NREC=0,TREC=0
|
|
F S IPIEN=$O(^PRCH(440.6,"PO",IPIEN)) Q:IPIEN'>0 D
|
|
.S IEN=0
|
|
.I '$D(^PRC(442,IPIEN)) D
|
|
..S TREC=TREC+1
|
|
..S IEN=0
|
|
..F S IEN=$O(^PRCH(440.6,"PO",IPIEN,IEN)) Q:'IEN D KILL4406
|
|
..Q
|
|
.Q
|
|
D CLEAN
|
|
Q
|
|
KILL4406 ;set temp files then kill invalid 440.6 records
|
|
N DA
|
|
S NREC=NREC+1
|
|
S ^XTMP("IFCAP-PURGE-440-6",IPIEN,IEN)=^PRCH(440.6,IEN,0)
|
|
S ^XTMP("IFCAP-PURGE-440-6-REF",IPIEN,IEN)="PO^"_IPIEN_"^"_IEN
|
|
S DA=IEN
|
|
S DIK="^PRCH(440.6," D ^DIK
|
|
K DIK,DA
|
|
Q
|
|
CLEAN K IEN,IPIEN,TREC,NREC
|
|
Q
|