| [613] | 1 | PRCSRCD ;ISC-SF/TKW-ALLOW ENTRY OF DATE RECEIVED ;10/11/91 10:27
|
|---|
| 2 | V ;;5.1;IFCAP;;Oct 20, 2000
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | EN1 ; LOOP THROUGH TRX.BY CONTROL POINT
|
|---|
| 5 | K PRC D EN3^PRCSUT G:'$D(PRC("SITE"))!('$D(PRC("CP"))) EXIT
|
|---|
| 6 | W ! S PRCSI="",PRCSCP=$P(PRC("CP")," ",1),PRCSLOOP=1 D RD1 W !,"***LAST TRANSACTION***",! G EXIT
|
|---|
| 7 | RD1 S PRCSI=$O(^PRCS(410,"AN",PRC("CP"),PRCSI)) Q:'PRCSI G:'$D(^PRCS(410,PRCSI,0)) RD1 G:$P(^(0),"^",2)'="O" RD1 W "." S X=PRCSI
|
|---|
| 8 | G:'$D(^PRCS(410,X,4)) RD1 G:$P(^(4),"^",5)="" RD1
|
|---|
| 9 | I $D(^PRCS(410,X,9)),$P(^(9),"^",3) G RD1
|
|---|
| 10 | S PRCSDT="",PRCSPO=$S($D(^PRCS(410,X,10)):+$P(^(10),"^",3),1:0) I '$D(^PRC(442,PRCSPO,0)) D RD2 G RD1
|
|---|
| 11 | S X=$P(^PRC(442,PRCSPO,0),"^",2) I (X>1)&(X<5) D RD2 G RD1
|
|---|
| 12 | S PRCSFINL=0 F I=0:0 S I=$O(^PRC(442,PRCSPO,11,I)) Q:'I I $D(^(I,0)),$P(^(0),U,9)="F" S PRCSFINL=1 Q
|
|---|
| 13 | G:'PRCSFINL RD1
|
|---|
| 14 | D RD2 Q:'PRCSLOOP G RD1
|
|---|
| 15 | RD2 W !,$P(^PRCS(410,PRCSI,0),"^",1),?20,"P.O.: "_$P(^(4),"^",5)
|
|---|
| 16 | I $D(^PRC(442,PRCSPO,0)) W " "_$S($D(^PRCD(442.5,+$P(^(0),U,2),0)):$E($P(^(0),U,1),1,16),1:"") S Y=$S($D(^PRC(442,PRCSPO,1)):$P(^(1),U,15),1:"") I Y D DD^%DT W " P.O.DATE: "_Y
|
|---|
| 17 | ;W ! F PRCSP=0:0 S PRCSP=$O(^PRC(442,PRCSPO,11,PRCSP)) Q:'PRCSP I $D(^(PRCSP,0)) W ?25,"PARTIAL#: ",PRCSP,?45 W:$P(^(0),U,9)="F" "*FINAL*" W ?54,"DATE: " S Y=$P(+$P(^(0),"^",1),".",1) D DD^%DT W Y,! S PRCSDT=Y
|
|---|
| 18 | S DR=48
|
|---|
| 19 | S DIE="^PRCS(410,",DA=PRCSI D ^DIE W ! S:$D(Y) PRCSLOOP=0 Q
|
|---|
| 20 | EN2 ;ENTER DATE RECEIVED ON SINGLE TRX.
|
|---|
| 21 | D EN3^PRCSUT G:'$D(PRC("SITE"))!(Y<0)!('$D(PRC("CP"))) EXIT
|
|---|
| 22 | E2 K D W !! S DIC="^PRCS(410,",DIE=DIC,DIC(0)="AEQM",DIC("A")="Select TRANSACTION or P.O. NUMBER: "
|
|---|
| 23 | S DIC("S")="I +^(0),$D(^(3)),+^(3)=+PRC(""CP""),$P(^(0),""^"",5)=PRC(""SITE""),$P(^(0),""^"",2)=""O"" I $D(^PRC(420,""A"",DUZ,PRC(""SITE""),+PRC(""CP""),1))!($D(^(2)))"
|
|---|
| 24 | D ^PRCSDIC G EXIT:Y<0 K DIC("S") S PRCSI=+Y
|
|---|
| 25 | I '$D(^PRCS(410,+Y,4)) G W S PRCSPO=$P(^(4),"^",5) I PRCSPO="" G W
|
|---|
| 26 | S PRCSDT="",PRCSPO=$S($D(^PRCS(410,+Y,10)):+$P(^(10),"^",3),1:0) I '$D(^PRC(442,PRCSPO,0)) D RD2 G E2
|
|---|
| 27 | S X=$P(^PRC(442,PRCSPO,0),"^",2) I (X>1)&(X<5) D RD2 G E2
|
|---|
| 28 | S PRCSFINL=0 F I=0:0 S I=$O(^PRC(442,PRCSPO,11,I)) Q:'I I $D(^(I,0)),$P(^(0),U,9)="F" S PRCSFINL=1 Q
|
|---|
| 29 | G:'PRCSFINL E2
|
|---|
| 30 | D RD2 G E2
|
|---|
| 31 | W W !,$C(7),"NO P.O.HAS BEEN ENTERED FOR THIS TRANSACTION!" G E2
|
|---|
| 32 | W2 W !,$C(7),"FINAL PARTIAL HAS NOT BEEN ENTERED FOR THIS P.O.!" G E2
|
|---|
| 33 | EXIT K PRC,PRCSI,PRCSCP,PRCSFINL,PRCSFY,PRCSIP,PRCSQ,PRCSX,PRCSDT,PRCSP,PRCSPO,X,Y,I,J,DIE,DR,DA,DIC,D0 Q
|
|---|
