source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCFDSC1.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: 1.9 KB
Line 
1PRCFDSC1 ;WISC@ALTOONA/CTB-PRINT CI REGISTRATION SCREEN ;9/22/94 15:31
2V ;;5.1;IFCAP;;Oct 20, 2000
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 N PRCFA,I,X,Y,% S %=1
5 I $D(^PRC(442,D0))<10 S %=0 Q
6 F I=0,1 S PRCFA("PO",I)=$S($D(^PRC(442,D0,I))'["0":^(I),1:"")
7 F I=0,1 I PRCFA("PO",I)="" S %=0 K PRCFA("PO") Q
8 Q:$G(%)=0
9 S X=$O(^PRC(442,D0,5,0)),PRCFA("PO",5)=$S(X'?1.N:"",$D(^PRC(442,D0,5,X,0))#10:^(0),1:"")
10 S PRCFA("VE")=+PRCFA("PO",1) F I=0,3,7 S PRCFA("VE",I)=""
11 I PRCFA("VE")>0,$D(^PRC(440,PRCFA("VE")))>9 F I=0,3,7 S PRCFA("VE",I)=$G(^PRC(440,PRCFA("VE"),I))
12 S PRCFOUT="PRCFA(""ORD""," K PRCFA("ORD") S PRCFA("TMP",1)=$P(PRCFA("VE",0),"^",2,5),PRCFA("TMP",2)=$P(PRCFA("VE",0),"^",6,8) D ^PRCFDADD
13 S PRCFOUT="PRCFA(""PAY""," K PRCFA("PAY") S PRCFA("TMP",1)=$P(PRCFA("VE",7),"^",3,6),PRCFA("TMP",2)=$P(PRCFA("VE",7),"^",7,9) D ^PRCFDADD
14 S PRCFX(1,"Purchase Order #: ~!")=$P(PRCFA("PO",0),"^")
15 S Y=$P(PRCFA("PO",1),"^",15) D D^PRCFQ S PRCFX(2,"PO Date: ~?40")=Y
16 S X=$P(PRCFA("PO",1),"^",6),DD=442,F=6.4 D ^PRCFU1 S PRCFX(3,"FOB: ~!!?2")=Y
17 S Y="UNKNOWN",X=$P(PRCFA("PO",0),"^",2) I X>0,$D(^PRCD(442.5,+X,0)),$P(^(0),"^")]"" S Y=$P(^(0),"^")
18 S PRCFX(4,"Method of Payment: ~?35")=Y
19 S X=PRCFA("PO",5) S Y=$P(X,"^")_$S($P(X,"^")>0:"% ",1:" ")_$P(X,"^",2),PRCFX(5,"Terms: ~!")=Y
20 S Y="UNKNOWN",X=$P(PRCFA("PO",1),"^",10) I X>0,$D(^VA(200,+X,0)),$P(^(0),"^")]"" S Y=$P(^(0),"^")
21 S PRCFX(6,"P/A: ~?40")=Y
22 S Y=$S($P(PRCFA("PO",0),"^",3)]"":$P(PRCFA("PO",0),"^",3),1:"UNKNOWN"),PRCFX(7,"FCP: ~!?2")=Y
23 S PRCFX(8,"Vendor: ~!!?10")=$P(PRCFA("VE",0),"^")
24 S PRCFX(9,"FMS Vendor Code: ~!!?1")=$P(PRCFA("VE",3),U,4)
25 S PRCFX(10,"Alternate Address Indicator: ~?40")=$P(PRCFA("VE",3),U,5)
26 S PRCFX(11,"Ordering Address: ~!!")="",PRCFX(12,"Payment Address: ~?40")=""
27 S N=13 F I=1:1:8 I $D(PRCFA("ORD",I))!($D(PRCFA("PAY",I))) S PRCFX(N,"~!")=$G(PRCFA("ORD",I)),PRCFX(N+1,"~?40")=$G(PRCFA("PAY",I)),N=N+2
28 D ^PRCFSCR
Note: See TracBrowser for help on using the repository browser.