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 Dec 13, 2024@02:06:11 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
