| 1 | PRCHCORE ;WISC/DJM-CORRECT ESIG #5 ;9/23/94  2:40 PM | 
|---|
| 2 | V ;;5.1;IFCAP;;Oct 20, 2000 | 
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified. | 
|---|
| 4 | ; | 
|---|
| 5 | ;THIS CORRECTION ROUTINE WILL RECODE THE ESIG AT FIELD 16.5 | 
|---|
| 6 | ;IN FILE 442.  THIS WILL ALLOW A VERSION 4 PO TO HAVE MORE | 
|---|
| 7 | ;THEN ONE VERSION 5 AMENDMENT. | 
|---|
| 8 | ; | 
|---|
| 9 | FIX N PO,PODATE,AMEND,AMEND3,COUNT,CHECKSUM,MESG1 | 
|---|
| 10 | S PODATE=2931000 F  S PODATE=$O(^PRC(442,"AB",PODATE)) Q:PODATE'>0  Q:PODATE>2940800  S PO=0 F  S PO=$O(^PRC(442,"AB",PODATE,PO)) Q:PO'>0  D | 
|---|
| 11 | .S AMEND=$G(^PRC(442,PO,6,0)) Q:AMEND="" | 
|---|
| 12 | .S (AMEND,COUNT)=0 F  S AMEND=$O(^PRC(442,PO,6,AMEND)) Q:AMEND'>0  D  Q:COUNT | 
|---|
| 13 | ..S AMEND3=$G(^PRC(442,PO,6,AMEND,3,1,0)) Q:AMEND3=""  D  Q | 
|---|
| 14 | ...S (CHECKSUM,MESG1)="" D RECODE^PRCHES5(PO,CHECKSUM,.MESG1) S COUNT=1 | 
|---|
| 15 | ...I MESG1'=1 W !,"The ESIG for PO number "_$P($G(^PRC(442,PO,0)),U)_" did not RECODE correctly." | 
|---|
| 16 | ...Q | 
|---|
| 17 | ..Q | 
|---|
| 18 | .Q | 
|---|
| 19 | Q | 
|---|