source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCFFUA2.m@ 1006

Last change on this file since 1006 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.7 KB
Line 
1PRCFFUA2 ;WISC/DJM-RESTORE BOC MULTIPLE & CLEAN UP CHANGES MULTIPLE ;2/13/95 3:08 PM
2V ;;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 ;
9START ;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 ;
32ZERO ;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
Note: See TracBrowser for help on using the repository browser.