- PRC5192P ;BP/TJH - IFCAP Post-Init for PRC*5.1*92 ; 28 Oct 2005 3:16 PM
- ;;5.1;IFCAP;**92**;Oct 20, 2000
- QUIT
- ;
- START ; remove invalid entries from the "C" xref of file #442
- D BMES^XPDUTL("Removing invalid entries from the C xref of file #442...")
- N PRCDA,PRCDB,PRCREC,PRCPO
- S PRCDA=0,U="^"
- F S PRCDA=$O(^PRC(442,"C",PRCDA)) Q:PRCDA="" D
- . S PRCDB=0
- . F S PRCDB=$O(^PRC(442,"C",PRCDA,PRCDB)) Q:PRCDB="" D
- .. S PRCREC=$G(^PRC(442,PRCDB,0)) ; get associated record, zero node
- .. S PRCPO=$P($P(PRCREC,U,1),"-",2) ; extract purchase order w/o STATION NUMBER
- .. I PRCPO'=PRCDA K ^PRC(442,"C",PRCDA,PRCDB) ; if PO# doesn't match subscript, remove the xref entry.
- D BMES^XPDUTL("Cleanup of C xref complete.")
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRC5192P 738 printed Mar 13, 2025@21:04:33 Page 2
- PRC5192P ;BP/TJH - IFCAP Post-Init for PRC*5.1*92 ; 28 Oct 2005 3:16 PM
- +1 ;;5.1;IFCAP;**92**;Oct 20, 2000
- +2 QUIT
- +3 ;
- START ; remove invalid entries from the "C" xref of file #442
- +1 DO BMES^XPDUTL("Removing invalid entries from the C xref of file #442...")
- +2 NEW PRCDA,PRCDB,PRCREC,PRCPO
- +3 SET PRCDA=0
- SET U="^"
- +4 FOR
- SET PRCDA=$ORDER(^PRC(442,"C",PRCDA))
- if PRCDA=""
- QUIT
- Begin DoDot:1
- +5 SET PRCDB=0
- +6 FOR
- SET PRCDB=$ORDER(^PRC(442,"C",PRCDA,PRCDB))
- if PRCDB=""
- QUIT
- Begin DoDot:2
- +7 ; get associated record, zero node
- SET PRCREC=$GET(^PRC(442,PRCDB,0))
- +8 ; extract purchase order w/o STATION NUMBER
- SET PRCPO=$PIECE($PIECE(PRCREC,U,1),"-",2)
- +9 ; if PO# doesn't match subscript, remove the xref entry.
- IF PRCPO'=PRCDA
- KILL ^PRC(442,"C",PRCDA,PRCDB)
- End DoDot:2
- End DoDot:1
- +10 DO BMES^XPDUTL("Cleanup of C xref complete.")
- +11 QUIT
