source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCCL406.m@ 1150

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

initial load of WorldVistAEHR

File size: 631 bytes
RevLine 
[613]1PRCCL406 ;BP-OIFO/SWS-IFCAP ARCHIVE/PURGE UTILITY ROUTINE ;12/07/2005 12:16
2V ;;5.1;IFCAP;**95**;Oct 20, 2000
3 Q
4START S IPIEN=0,NREC=0,TREC=0
5 F S IPIEN=$O(^PRCH(440.6,"PO",IPIEN)) Q:IPIEN'>0 D
6 .S IEN=0
7 .I '$D(^PRC(442,IPIEN)) D
8 ..S TREC=TREC+1
9 ..S IEN=0
10 ..F S IEN=$O(^PRCH(440.6,"PO",IPIEN,IEN)) Q:'IEN D KILL4406
11 ..Q
12 .Q
13 D CLEAN
14 Q
15KILL4406 ;set temp files then kill invalid 440.6 records
16 N DA
17 S NREC=NREC+1
18 S ^XTMP("IFCAP-PURGE-440-6",IPIEN,IEN)=^PRCH(440.6,IEN,0)
19 S ^XTMP("IFCAP-PURGE-440-6-REF",IPIEN,IEN)="PO^"_IPIEN_"^"_IEN
20 S DA=IEN
21 S DIK="^PRCH(440.6," D ^DIK
22 K DIK,DA
23 Q
24CLEAN K IEN,IPIEN,TREC,NREC
25 Q
Note: See TracBrowser for help on using the repository browser.