source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCSRCD.m@ 1078

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

initial load of WorldVistAEHR

File size: 2.4 KB
Line 
1PRCSRCD ;ISC-SF/TKW-ALLOW ENTRY OF DATE RECEIVED ;10/11/91 10:27
2V ;;5.1;IFCAP;;Oct 20, 2000
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4EN1 ; 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
7RD1 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
15RD2 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
20EN2 ;ENTER DATE RECEIVED ON SINGLE TRX.
21 D EN3^PRCSUT G:'$D(PRC("SITE"))!(Y<0)!('$D(PRC("CP"))) EXIT
22E2 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
31W W !,$C(7),"NO P.O.HAS BEEN ENTERED FOR THIS TRANSACTION!" G E2
32W2 W !,$C(7),"FINAL PARTIAL HAS NOT BEEN ENTERED FOR THIS P.O.!" G E2
33EXIT K PRC,PRCSI,PRCSCP,PRCSFINL,PRCSFY,PRCSIP,PRCSQ,PRCSX,PRCSDT,PRCSP,PRCSPO,X,Y,I,J,DIE,DR,DA,DIC,D0 Q
Note: See TracBrowser for help on using the repository browser.