- PRCHCORE ;WISC/DJM-CORRECT ESIG #5 ;9/23/94 2:40 PM
- V ;;5.1;IFCAP;;Oct 20, 2000
- ;Per VHA Directive 10-93-142, this routine should not be modified.
- ;
- ;THIS CORRECTION ROUTINE WILL RECODE THE ESIG AT FIELD 16.5
- ;IN FILE 442. THIS WILL ALLOW A VERSION 4 PO TO HAVE MORE
- ;THEN ONE VERSION 5 AMENDMENT.
- ;
- FIX N PO,PODATE,AMEND,AMEND3,COUNT,CHECKSUM,MESG1
- 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
- .S AMEND=$G(^PRC(442,PO,6,0)) Q:AMEND=""
- .S (AMEND,COUNT)=0 F S AMEND=$O(^PRC(442,PO,6,AMEND)) Q:AMEND'>0 D Q:COUNT
- ..S AMEND3=$G(^PRC(442,PO,6,AMEND,3,1,0)) Q:AMEND3="" D Q
- ...S (CHECKSUM,MESG1)="" D RECODE^PRCHES5(PO,CHECKSUM,.MESG1) S COUNT=1
- ...I MESG1'=1 W !,"The ESIG for PO number "_$P($G(^PRC(442,PO,0)),U)_" did not RECODE correctly."
- ...Q
- ..Q
- .Q
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCHCORE 891 printed Apr 23, 2025@18:20:40 Page 2
- PRCHCORE ;WISC/DJM-CORRECT ESIG #5 ;9/23/94 2:40 PM
- V ;;5.1;IFCAP;;Oct 20, 2000
- +1 ;Per VHA Directive 10-93-142, this routine should not be modified.
- +2 ;
- +3 ;THIS CORRECTION ROUTINE WILL RECODE THE ESIG AT FIELD 16.5
- +4 ;IN FILE 442. THIS WILL ALLOW A VERSION 4 PO TO HAVE MORE
- +5 ;THEN ONE VERSION 5 AMENDMENT.
- +6 ;
- FIX NEW PO,PODATE,AMEND,AMEND3,COUNT,CHECKSUM,MESG1
- +1 SET PODATE=2931000
- FOR
- SET PODATE=$ORDER(^PRC(442,"AB",PODATE))
- if PODATE'>0
- QUIT
- if PODATE>2940800
- QUIT
- SET PO=0
- FOR
- SET PO=$ORDER(^PRC(442,"AB",PODATE,PO))
- if PO'>0
- QUIT
- Begin DoDot:1
- +2 SET AMEND=$GET(^PRC(442,PO,6,0))
- if AMEND=""
- QUIT
- +3 SET (AMEND,COUNT)=0
- FOR
- SET AMEND=$ORDER(^PRC(442,PO,6,AMEND))
- if AMEND'>0
- QUIT
- Begin DoDot:2
- +4 SET AMEND3=$GET(^PRC(442,PO,6,AMEND,3,1,0))
- if AMEND3=""
- QUIT
- Begin DoDot:3
- +5 SET (CHECKSUM,MESG1)=""
- DO RECODE^PRCHES5(PO,CHECKSUM,.MESG1)
- SET COUNT=1
- +6 IF MESG1'=1
- WRITE !,"The ESIG for PO number "_$PIECE($GET(^PRC(442,PO,0)),U)_" did not RECODE correctly."
- +7 QUIT
- End DoDot:3
- QUIT
- +8 QUIT
- End DoDot:2
- if COUNT
- QUIT
- +9 QUIT
- End DoDot:1
- +10 QUIT
