source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRC5192P.m@ 1141

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

initial load of WorldVistAEHR

File size: 722 bytes
Line 
1PRC5192P ;BP/TJH - IFCAP Post-Init for PRC*5.1*92 ; 28 Oct 2005 3:16 PM
2 ;;5.1;IFCAP;**92**;Oct 20, 2000
3 QUIT
4 ;
5START ; remove invalid entries from the "C" xref of file #442
6 D BMES^XPDUTL("Removing invalid entries from the C xref of file #442...")
7 N PRCDA,PRCDB,PRCREC,PRCPO
8 S PRCDA=0,U="^"
9 F S PRCDA=$O(^PRC(442,"C",PRCDA)) Q:PRCDA="" D
10 . S PRCDB=0
11 . F S PRCDB=$O(^PRC(442,"C",PRCDA,PRCDB)) Q:PRCDB="" D
12 .. S PRCREC=$G(^PRC(442,PRCDB,0)) ; get associated record, zero node
13 .. S PRCPO=$P($P(PRCREC,U,1),"-",2) ; extract purchase order w/o STATION NUMBER
14 .. I PRCPO'=PRCDA K ^PRC(442,"C",PRCDA,PRCDB) ; if PO# doesn't match subscript, remove the xref entry.
15 D BMES^XPDUTL("Cleanup of C xref complete.")
16 Q
Note: See TracBrowser for help on using the repository browser.