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