Last change
on this file since 780 was 613, checked in by George Lilly, 15 years ago |
initial load of WorldVistAEHR
|
File size:
722 bytes
|
Rev | Line | |
---|
[613] | 1 | PRC5192P ;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 | ;
|
---|
| 5 | START ; 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.