|
Last change
on this file since 841 was 613, checked in by George Lilly, 15 years ago |
|
initial load of WorldVistAEHR
|
|
File size:
722 bytes
|
| Line | |
|---|
| 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.
