source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCOESE1.m@ 1800

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

initial load of WorldVistAEHR

File size: 5.6 KB
RevLine 
[613]1PRCOESE1 ;WISC/DJM-IFCAP EDI POA SERVER INTERFACE, CONT. ; [8/31/98 2:03pm]
2V ;;5.1;IFCAP;;Oct 20, 2000
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4MSG ; ENTER MAILMAN MESSAGE INFORMING WHOMEVER ABOUT PROBLEMS WITH
5 ; INCOMMING 'POA' TRANSACTION.
6 ;
7 N BB,II,L
8 S XMSUB="IFCAP 'POA' for Purchase Order "_$G(CC)
9 S XMDUZ="IFCAP 'POA' SERVER"
10 F I=1:1:5 D XMZ^XMA2 Q:XMZ>0
11 I I=5,XMZ<1 Q ;MIGHT NEED TO REDO 'GET^XMA2' IF I=5 AND THERE IS NO XMZ.
12 I $G(ERR("SEG"))]"" S ^XMB(3.9,XMZ,2,1,0)="The "_A_" segment is not found in the POA transaction.",^XMB(3.9,XMZ,2,2,0)="Contact the EDI HELP DESK in Austin about this transaction.",L=3 G SEND
13 I $G(ERR("STATION"))]"" S ^XMB(3.9,XMZ,2,1,0)="The "_STATION_" site listed in the POA transaction can not be found",^XMB(3.9,XMZ,2,2,0)="in the IFCAP ADMIN ACTIVITY SITE PARAMETER file.",L=3 G SEND
14 I $G(ERR("RECORD"))]"" S ^XMB(3.9,XMZ,2,1,0)="Record "_CC_", "_$C(34)_"PHA"_$C(34)_", "_VENDOR_" was not found in file 443.75.",L=2 G SEND
15 I $G(ERR("VENDOR"))]"" S ^XMB(3.9,XMZ,2,1,0)="Record "_CC_" does not have a VENDOR ID number.",L=2 G SEND
16 S M1=""
17 S L=1
18 F S M1=$O(ERR(CC,M1)) Q:M1="" I ERR(CC,M1)]"" D
19 . I M1=0,$P(ERR(CC,M1),U)]"" S ^XMB(3.9,XMZ,2,L,0)="Purchase Order Acknowledgment "_CC_" was not found in the PO file.",L=L+1
20 . I M1>0,$P(ERR(CC,M1),U,2,99)]"" F II=2:1:13 S BB=$P(ERR(CC,M1),U,II) I BB]"" D
21 . . I II=2 S ^XMB(3.9,XMZ,2,L,0)="Item "_M1_" was not found in PO "_CC_".",L=L+1 Q
22 . . I II=3 S ^XMB(3.9,XMZ,2,L,0)="The Vendor Stock Number wasn't found in item "_M1_".",L=L+1 Q
23 . . I II=5 S ^XMB(3.9,XMZ,2,L,0)="There is no quantity listed for item "_M1_".",L=L+1 Q
24 . . I II=6 S ^XMB(3.9,XMZ,2,L,0)="There is no Unit of Purchase listed for item "_M1_".",L=L+1 Q
25 . . I II=7 S ^XMB(3.9,XMZ,2,L,0)="There is no Unit Cost listed for item "_M1_".",L=L+1 Q
26 . . I II=9 S ^XMB(3.9,XMZ,2,L,0)="The Vendor Stock Number from the POA doesn't match the one from item "_M1_".",L=L+1 Q
27 . . I II=10 S ^XMB(3.9,XMZ,2,L,0)="The Quantity listed in the POA doesn't match the one listed in item "_M1_".",L=L+1 Q
28 . . I II=11 S ^XMB(3.9,XMZ,2,L,0)="The Unit of Purchase listed in the POA doesn't match the one in item "_M1_".",L=L+1 Q
29 . . I II=12 S ^XMB(3.9,XMZ,2,L,0)="The Unit Cost listed in the POA doesn't match the one in item "_M1_".",L=L+1 Q
30 . . I II=13 S ^XMB(3.9,XMZ,2,L,0)="The POA for PO "_CC_" is missing a line item number.",L=L+1 Q
31 . . Q
32 . Q
33 Q:L=1
34 ;
35SEND ; COME HERE TO SEND THE MAILMAN MESSAGE BUILT UP IN 'MSG' ABOVE.
36 S L=L-1
37 S ^XMB(3.9,XMZ,2,0)="^3.9A^"_L_"^"_L_"^"_DT
38 S XMDUN="IFCAP 'POA' PROBLEM"
39 S X="G.EDP"
40 D WHO^XMA21
41 S:'$L($O(XMY(""))) XMY(.5)=""
42 S:$G(PPM)]"" XMY(PPM)=""
43 D ENT1^XMD
44 K XMY
45 Q
46 ;
47BUL ; THIS BULLETIN WILL NOTIFY THAT A 'POA' TRANSACTION HAS ARRIVED
48 ; FROM AUSTIN.
49 N XMDUZ,XMB,DATE,X,Y,XMB,%,%DT
50 S XMDUZ="POA Server Interface"
51 S XMB="PRCOEDI ACKNOWLEDGE"
52 D NOW^%DTC
53 S Y=%
54 S %DT="S"
55 D DD^%DT
56 S XMB(3)=$P(Y,"@")
57 S XMB(4)=$P(Y,"@",2)
58 S XMB(5)=CC
59 S DATE=$P(LINE,U,5)
60 S X1=$E(DATE,1,4)-1700_"0101"
61 S X2=+$E(DATE,5,7)-1
62 D C^%DTC
63 S Y=X_"."_$P(LINE,U,6)
64 D DD^%DT
65 S XMB(1)=Y
66 S XMB(2)=$P(LINE,U,3)
67 S XMY(PPM)=""
68 D ^XMB
69 Q
70 ;
71DATE(DATE) ; THIS EXTRINSIC FUNCTION WILL RETURN THE DATE IN YYYYJJJ FORMAT
72 ; WHERE YYYY IS 4 DIGIT YEAR AND JJJ IS THE DAY OF THE YEAR.
73 ;
74 ; THE INPUT PARAMETER, DATE, IS THE DATE TO CONVERT ENTERED IN
75 ; VA FILEMAN FORMAT WITHOUT ANY TIME. THE DATE MUST CONTAIN
76 ; YEAR, MONTH AND DAY.
77 ;
78 N X,%Y
79 S X1=DATE
80 S X2=$E(DATE,1,3)_"0101"
81 D ^%DTC
82 S X=X+1
83 S X="000"_X
84 S X=$E(X,$L(X)-2,99)
85 Q $E(DATE,1,3)+1700_X
86 ;
87TEXT(ENTRY,M1,CC) ; HOW TO RETRIEVE TEXT OF ERROR LISTINGS AND INCLUDE IN
88 ; THEM THE
89 ; 'LINE ITEM NUMBER' ALONG WITH THE 'PURCHASE ORDER NUMBER' AS
90 ; NEEDED.
91 ;
92 ; Call this entry as an EXTRINSIC FUNCTION call.
93 ; S AA=$$TEXT^PRCOESE1(ENTRY,M1,CC)
94 ;
95 ; On completion of function call AA will contain the text in PRCOER.
96 ;
97 ; INPUT PARAMETERS WHAT THEY MEAN
98 ; ENTRY THE '^' SEPARATED PIECE THAT HAS A '*'
99 ; FROM THE ERR(CC,B) ARRAY CREATED IN
100 ; PRCOESE.
101 ; M1 THE 'B' FROM THE ARRAY. THE 'LINE
102 ; ITEM NUMBER' OF THE PO RECORD FROM THE
103 ; 'POA' TRANSACTION BEING ENTERED.
104 ; CC THE 'PURCHASE ORDER NUMBER' FROM THE 'POA'
105 ; TRANSACTION BEING ENTERED.
106 ;
107 ; OUTPUT PARAMETER WHAT IT MEANS
108 ; PRCOER THIS IS THE TEXT FROM 'LINES' WITH 'M1'
109 ; AND 'CC' REPLACED WITH THEIR VALUES.
110 ;
111 N PRCOER
112 ;
113 ; POINT TO THE CORRECT LOCATION FOR THE LINE WANTED.
114 ;
115 S PRCOER=""
116 I ENTRY="" Q PRCOER
117 ;
118 ; GET THE TEXT WITHIN THE LINE.
119 ;
120 S PRCOER=$P($T(LINES+ENTRY),";;",2)
121 ;
122 ; NOW LETS RESOLVE ALL VARIAVLES WITHIN THE LINE TO ITS ACTUAL TEXT.
123 ; START AFTER THE SECOND QUOTATION MARK (") AND REPLACE ALL VARIABLES
124 ; WITH THE VALUE (TEXT) OF THE VARIABLE.
125 ;
126 I PRCOER["_M1_" S PRCOER=$P(PRCOER,"_M1_")_M1_$P(PRCOER,"_M1_",2)
127 I PRCOER["_CC_" S PRCOER=$P(PRCOER,"_CC_")_CC_$P(PRCOER,"_CC_",2)
128 Q PRCOER
129 ;
130LINES ;Error messages
131 ;;
132 ;;Item _M1_ was not found in PO _CC_.
133 ;;The Vendor Stock Number wasn't found in item _M1_.
134 ;;
135 ;;There is no quantity listed for item _M1_.
136 ;;There is no Unit of Purchase listed for item _M1_.
137 ;;There is no Unit Cost listed for item _M1_.
138 ;;
139 ;;The Vendor Stock Number from the POA doesn't match the one from item _M1_.
140 ;;The Quantity listed in the POA doesn't match the one listed in item _M1_.
141 ;;The Unit of Purchase listed in the POA doesn't match the one in item _M1_.
142 ;;The Unit Cost listed in the POA doesn't match the one in item _M1_.
143 ;;The POA for PO _CC_ is missing a line item number.
Note: See TracBrowser for help on using the repository browser.