| 1 | PRCSES2 ;SF-ISC/KSS/LJP-X-REF SET STATEMENT FOR ITEM QTY ;9/17/92 3:40 PM
|
|---|
| 2 | V ;;5.1;IFCAP;;Oct 20, 2000
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | Q:'$D(^PRCS(410,DA(1),"IT",DA,0)) Q:'$P(^(0),U,2)
|
|---|
| 5 | S E=0,E(1)="" S:'$D(^PRCS(410,DA(1),4)) ^(4)=""
|
|---|
| 6 | F E(0)=1:1 S E=$O(^PRCS(410,DA(1),"IT",E)) S:E?1N.N E(1)=E(1)+($P(^(E,0),U,2)*$P(^(0),U,7)) I E'?1N.N D PR1 K E Q
|
|---|
| 7 | K E Q
|
|---|
| 8 | PR1 S ^PRCS(410,DA(1),4)=E(1)_U_$P(^PRCS(410,DA(1),4),U,2,99),E=DA,E(2)=DA(1),X=E(1),DA=DA(1) D PR2 S DA=E,DA(1)=E(2) Q
|
|---|
| 9 | PR2 Q:$P(^PRCS(410,DA,4),U,3)'="" S $P(^(4),U,8)=X D TRANS^PRCSES Q
|
|---|
| 10 | OBL ;copy or null fields for 1358 adj in file 410
|
|---|
| 11 | N A,GOFLAG
|
|---|
| 12 | S A=+$G(^PRCS(410,DA,0))
|
|---|
| 13 | K PRCS(2) S (PRCS(1),PRCSI,GOFLAG)=0
|
|---|
| 14 | F PRCSI=0:0 S PRCS(1)=$O(^PRCS(410,"D",PRCX442,PRCS(1))) Q:PRCS(1)'>0 D I GOFLAG S PRCS(2)="" Q
|
|---|
| 15 | .; additional checks added for checking FORM TYPE and FY
|
|---|
| 16 | .; X1 = FY from newly created adjustment
|
|---|
| 17 | .; x2 = FY from record being checked
|
|---|
| 18 | .S X2=$P($P(^PRCS(410,PRCS(1),0),U),"-",2)
|
|---|
| 19 | .S X2=$$YEAR^PRC0C(X2),X2=$P(X2,U)
|
|---|
| 20 | .S X2=$$DATE^PRC0C(X2,"E"),X2=$P(X2,U,7)
|
|---|
| 21 | .S X1=$P($P(^PRCS(410,DA,0),U),"-",2)
|
|---|
| 22 | .S X1=$$YEAR^PRC0C(X1),X1=$P(X1,U)
|
|---|
| 23 | .S X1=$$DATE^PRC0C(X1,"E"),X1=$P(X1,U,7)
|
|---|
| 24 | .D ^%DTC
|
|---|
| 25 | .I $D(^PRCS(410,PRCS(1),0)),$P(^(0),U,2)="O",+^(0)=A,$P(^(0),U,4)=1,X<1865 S GOFLAG=1
|
|---|
| 26 | .Q
|
|---|
| 27 | I '$D(PRCS(2)) K PRCS(1),PRCSI Q
|
|---|
| 28 | I $D(^PRCS(410,PRCS(1),11)),$P(^(11),U)]"" S ^PRCS(410,DA,11)=$P(^PRCS(410,PRCS(1),11),U),^PRCS(410,"J",$P(^(11),U),DA)=""
|
|---|
| 29 | I $D(^PRCS(410,PRCS(1),2)) S $P(^PRCS(410,DA,2),U)=$P(^PRCS(410,PRCS(1),2),U),^PRCS(410,"E",$E($P(^(2),U),1,30),DA)="" S:$D(^PRCS(410,PRCS(1),3)) $P(^PRCS(410,DA,3),U,4)=$P(^PRCS(410,PRCS(1),3),U,4)
|
|---|
| 30 | S:$P(^PRCS(410,PRCS(1),0),U,4)=1 PRCS58=1
|
|---|
| 31 | I $D(^PRCS(410,PRCS(1),3)) S $P(^PRCS(410,DA,3),U,2,3)=$P(^(3),U,2,3),^PRCS(410,"AC",$P(^(3),U,3),DA)=""
|
|---|
| 32 | I $D(^PRCS(410,PRCS(1),3)),$P(^(3),U,6)]"" S $P(^PRCS(410,DA,3),U,6)=$P(^(3),U,6),^PRCS(410,"AD",$P(^(3),U,6),DA)=""
|
|---|
| 33 | I $D(^PRCS(410,PRCS(1),3)),$P(^(3),U,8)]"" S $P(^PRCS(410,DA,3),U,8)=$P(^(3),U,8),^PRCS(410,"AP",$P(^(3),U,8),DA)=""
|
|---|
| 34 | K PRCS(1),PRCS(2),PRCSI Q
|
|---|
