| 1 | PRCFFUA2 ;WISC/DJM-RESTORE BOC MULTIPLE & CLEAN UP CHANGES MULTIPLE ;2/13/95 3:08 PM
|
|---|
| 2 | V ;;5.1;IFCAP;;Oct 20, 2000
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;THIS ROUTINE IS USED TO RESTORE THE BOC NODES, NODE 22, AND THE
|
|---|
| 5 | ;CHANGES NODES, NODE 6 - AMENDMENT - NODE 3, BACK TO THEIR VALUES
|
|---|
| 6 | ;PRIOR TO THE CURRENT AMENDMENT. THIS IS REQUIRED TO PROPERLY
|
|---|
| 7 | ;RE-GENERATE THE CURRENT AMENDMENT MO/SO DOCUMENT.
|
|---|
| 8 | ;
|
|---|
| 9 | START ;SEARCH THROUGH THE AMENDMENT FOR BOC CHANGES. BOC CHANGES ARE
|
|---|
| 10 | ;ENTRIES WITH THE SECOND '^' PIECE EQUAL TO "".
|
|---|
| 11 | N LOOP,VAL,OLD,ENTRY,FIELD,SUB,BOC,AMT,FMS
|
|---|
| 12 | S LOOP=0
|
|---|
| 13 | F S LOOP=$O(^PRC(442,PRCHPO,6,PRCHAM,3,LOOP)) Q:LOOP'>0 S VAL=$G(^(LOOP,0)) D:$P(VAL,U,2)=""
|
|---|
| 14 | .S OLD=$G(^PRC(442,PRCHPO,6,PRCHAM,3,LOOP,1,1,0))
|
|---|
| 15 | .S ENTRY=$P(VAL,U,4)
|
|---|
| 16 | .S FIELD=$P($P(VAL,U,3),";")
|
|---|
| 17 | .S SUB=$P($P($P(VAL,U,3),":"),";",2)
|
|---|
| 18 | .Q:SUB'="442.041"
|
|---|
| 19 | .I FIELD=".01" D
|
|---|
| 20 | ..S BOC=$P(^PRC(442,PRCHPO,22,ENTRY,0),U)
|
|---|
| 21 | ..K ^PRC(442,PRCHPO,22,"B",BOC,ENTRY)
|
|---|
| 22 | ..S $P(^PRC(442,PRCHPO,22,ENTRY,0),U)=+OLD
|
|---|
| 23 | ..S ^PRC(442,PRCHPO,22,"B",+OLD,ENTRY)=""
|
|---|
| 24 | ..Q
|
|---|
| 25 | .I FIELD="1" S $P(^PRC(442,PRCHPO,22,ENTRY,0),U,2)=OLD
|
|---|
| 26 | .I FIELD="2" S $P(^PRC(442,PRCHPO,22,ENTRY,0),U,3)=OLD
|
|---|
| 27 | .K ^PRC(442,PRCHPO,6,PRCHAM,3,LOOP)
|
|---|
| 28 | .K ^PRC(442,PRCHPO,6,PRCHAM,3,"B",$P(VAL,U),LOOP)
|
|---|
| 29 | .S $P(^PRC(442,PRCHPO,6,PRCHAM,3,0),U,4)=$P(^PRC(442,PRCHPO,6,PRCHAM,3,0),U,4)-1
|
|---|
| 30 | .Q
|
|---|
| 31 | ;
|
|---|
| 32 | ZERO ;NOW LETS REMOVE ANY ENTRIES IN NODE 22 WITH ALL THREE FIELDS
|
|---|
| 33 | ;SET TO '0'.
|
|---|
| 34 | S LOOP=0
|
|---|
| 35 | F S LOOP=$O(^PRC(442,PRCHPO,22,LOOP)) Q:LOOP'>0 D
|
|---|
| 36 | .S VAL=$G(^PRC(442,PRCHPO,22,LOOP,0))
|
|---|
| 37 | .S BOC=$P(VAL,U) Q:VAL>0
|
|---|
| 38 | .S AMT=$P(VAL,U,2) Q:AMT>0
|
|---|
| 39 | .S FMS=$P(VAL,U,3) Q:FMS>0
|
|---|
| 40 | .K ^PRC(442,PRCHPO,22,LOOP,0),^PRC(442,PRCHPO,22,"B",BOC,LOOP)
|
|---|
| 41 | .S $P(^PRC(442,PRCHPO,22,0),U,4)=$P(^PRC(442,PRCHPO,22,0),U,4)-1
|
|---|
| 42 | .Q
|
|---|
| 43 | Q
|
|---|
