PRCOESE1 ;WISC/DJM-IFCAP EDI POA SERVER INTERFACE, CONT. ; [8/31/98 2:03pm]
V ;;5.1;IFCAP;;Oct 20, 2000
;Per VHA Directive 10-93-142, this routine should not be modified.
MSG ; ENTER MAILMAN MESSAGE INFORMING WHOMEVER ABOUT PROBLEMS WITH
; INCOMMING 'POA' TRANSACTION.
;
N BB,II,L
S XMSUB="IFCAP 'POA' for Purchase Order "_$G(CC)
S XMDUZ="IFCAP 'POA' SERVER"
F I=1:1:5 D XMZ^XMA2 Q:XMZ>0
I I=5,XMZ<1 Q ;MIGHT NEED TO REDO 'GET^XMA2' IF I=5 AND THERE IS NO XMZ.
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
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
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
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
S M1=""
S L=1
F S M1=$O(ERR(CC,M1)) Q:M1="" I ERR(CC,M1)]"" D
. 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
. 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
. . I II=2 S ^XMB(3.9,XMZ,2,L,0)="Item "_M1_" was not found in PO "_CC_".",L=L+1 Q
. . 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
. . I II=5 S ^XMB(3.9,XMZ,2,L,0)="There is no quantity listed for item "_M1_".",L=L+1 Q
. . 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
. . I II=7 S ^XMB(3.9,XMZ,2,L,0)="There is no Unit Cost listed for item "_M1_".",L=L+1 Q
. . 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
. . 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
. . 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
. . 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
. . 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
. . Q
. Q
Q:L=1
;
SEND ; COME HERE TO SEND THE MAILMAN MESSAGE BUILT UP IN 'MSG' ABOVE.
S L=L-1
S ^XMB(3.9,XMZ,2,0)="^3.9A^"_L_"^"_L_"^"_DT
S XMDUN="IFCAP 'POA' PROBLEM"
S X="G.EDP"
D WHO^XMA21
S:'$L($O(XMY(""))) XMY(.5)=""
S:$G(PPM)]"" XMY(PPM)=""
D ENT1^XMD
K XMY
Q
;
BUL ; THIS BULLETIN WILL NOTIFY THAT A 'POA' TRANSACTION HAS ARRIVED
; FROM AUSTIN.
N XMDUZ,XMB,DATE,X,Y,XMB,%,%DT
S XMDUZ="POA Server Interface"
S XMB="PRCOEDI ACKNOWLEDGE"
D NOW^%DTC
S Y=%
S %DT="S"
D DD^%DT
S XMB(3)=$P(Y,"@")
S XMB(4)=$P(Y,"@",2)
S XMB(5)=CC
S DATE=$P(LINE,U,5)
S X1=$E(DATE,1,4)-1700_"0101"
S X2=+$E(DATE,5,7)-1
D C^%DTC
S Y=X_"."_$P(LINE,U,6)
D DD^%DT
S XMB(1)=Y
S XMB(2)=$P(LINE,U,3)
S XMY(PPM)=""
D ^XMB
Q
;
DATE(DATE) ; THIS EXTRINSIC FUNCTION WILL RETURN THE DATE IN YYYYJJJ FORMAT
; WHERE YYYY IS 4 DIGIT YEAR AND JJJ IS THE DAY OF THE YEAR.
;
; THE INPUT PARAMETER, DATE, IS THE DATE TO CONVERT ENTERED IN
; VA FILEMAN FORMAT WITHOUT ANY TIME. THE DATE MUST CONTAIN
; YEAR, MONTH AND DAY.
;
N X,%Y
S X1=DATE
S X2=$E(DATE,1,3)_"0101"
D ^%DTC
S X=X+1
S X="000"_X
S X=$E(X,$L(X)-2,99)
Q $E(DATE,1,3)+1700_X
;
TEXT(ENTRY,M1,CC) ; HOW TO RETRIEVE TEXT OF ERROR LISTINGS AND INCLUDE IN
; THEM THE
; 'LINE ITEM NUMBER' ALONG WITH THE 'PURCHASE ORDER NUMBER' AS
; NEEDED.
;
; Call this entry as an EXTRINSIC FUNCTION call.
; S AA=$$TEXT^PRCOESE1(ENTRY,M1,CC)
;
; On completion of function call AA will contain the text in PRCOER.
;
; INPUT PARAMETERS WHAT THEY MEAN
; ENTRY THE '^' SEPARATED PIECE THAT HAS A '*'
; FROM THE ERR(CC,B) ARRAY CREATED IN
; PRCOESE.
; M1 THE 'B' FROM THE ARRAY. THE 'LINE
; ITEM NUMBER' OF THE PO RECORD FROM THE
; 'POA' TRANSACTION BEING ENTERED.
; CC THE 'PURCHASE ORDER NUMBER' FROM THE 'POA'
; TRANSACTION BEING ENTERED.
;
; OUTPUT PARAMETER WHAT IT MEANS
; PRCOER THIS IS THE TEXT FROM 'LINES' WITH 'M1'
; AND 'CC' REPLACED WITH THEIR VALUES.
;
N PRCOER
;
; POINT TO THE CORRECT LOCATION FOR THE LINE WANTED.
;
S PRCOER=""
I ENTRY="" Q PRCOER
;
; GET THE TEXT WITHIN THE LINE.
;
S PRCOER=$P($T(LINES+ENTRY),";;",2)
;
; NOW LETS RESOLVE ALL VARIAVLES WITHIN THE LINE TO ITS ACTUAL TEXT.
; START AFTER THE SECOND QUOTATION MARK (") AND REPLACE ALL VARIABLES
; WITH THE VALUE (TEXT) OF THE VARIABLE.
;
I PRCOER["_M1_" S PRCOER=$P(PRCOER,"_M1_")_M1_$P(PRCOER,"_M1_",2)
I PRCOER["_CC_" S PRCOER=$P(PRCOER,"_CC_")_CC_$P(PRCOER,"_CC_",2)
Q PRCOER
;
LINES ;Error messages
;;
;;Item _M1_ was not found in PO _CC_.
;;The Vendor Stock Number wasn't found in item _M1_.
;;
;;There is no quantity listed for item _M1_.
;;There is no Unit of Purchase listed for item _M1_.
;;There is no Unit Cost listed for item _M1_.
;;
;;The Vendor Stock Number from the POA doesn't match the one from item _M1_.
;;The Quantity listed in the POA doesn't match the one listed in item _M1_.
;;The Unit of Purchase listed in the POA doesn't match the one in item _M1_.
;;The Unit Cost listed in the POA doesn't match the one in item _M1_.
;;The POA for PO _CC_ is missing a line item number.
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCOESE1 5913 printed Nov 22, 2024@17:22:05 Page 2
PRCOESE1 ;WISC/DJM-IFCAP EDI POA SERVER INTERFACE, CONT. ; [8/31/98 2:03pm]
V ;;5.1;IFCAP;;Oct 20, 2000
+1 ;Per VHA Directive 10-93-142, this routine should not be modified.
MSG ; ENTER MAILMAN MESSAGE INFORMING WHOMEVER ABOUT PROBLEMS WITH
+1 ; INCOMMING 'POA' TRANSACTION.
+2 ;
+3 NEW BB,II,L
+4 SET XMSUB="IFCAP 'POA' for Purchase Order "_$GET(CC)
+5 SET XMDUZ="IFCAP 'POA' SERVER"
+6 FOR I=1:1:5
DO XMZ^XMA2
if XMZ>0
QUIT
+7 ;MIGHT NEED TO REDO 'GET^XMA2' IF I=5 AND THERE IS NO XMZ.
IF I=5
IF XMZ<1
QUIT
+8 IF $GET(ERR("SEG"))]""
SET ^XMB(3.9,XMZ,2,1,0)="The "_A_" segment is not found in the POA transaction."
SET ^XMB(3.9,XMZ,2,2,0)="Contact the EDI HELP DESK in Austin about this transaction."
SET L=3
GOTO SEND
+9 IF $GET(ERR("STATION"))]""
SET ^XMB(3.9,XMZ,2,1,0)="The "_STATION_" site listed in the POA transaction can not be found"
SET ^XMB(3.9,XMZ,2,2,0)="in the IFCAP ADMIN ACTIVITY SITE PARAMETER file."
SET L=3
GOTO SEND
+10 IF $GET(ERR("RECORD"))]""
SET ^XMB(3.9,XMZ,2,1,0)="Record "_CC_", "_$CHAR(34)_"PHA"_$CHAR(34)_", "_VENDOR_" was not found in file 443.75."
SET L=2
GOTO SEND
+11 IF $GET(ERR("VENDOR"))]""
SET ^XMB(3.9,XMZ,2,1,0)="Record "_CC_" does not have a VENDOR ID number."
SET L=2
GOTO SEND
+12 SET M1=""
+13 SET L=1
+14 FOR
SET M1=$ORDER(ERR(CC,M1))
if M1=""
QUIT
IF ERR(CC,M1)]""
Begin DoDot:1
+15 IF M1=0
IF $PIECE(ERR(CC,M1),U)]""
SET ^XMB(3.9,XMZ,2,L,0)="Purchase Order Acknowledgment "_CC_" was not found in the PO file."
SET L=L+1
+16 IF M1>0
IF $PIECE(ERR(CC,M1),U,2,99)]""
FOR II=2:1:13
SET BB=$PIECE(ERR(CC,M1),U,II)
IF BB]""
Begin DoDot:2
+17 IF II=2
SET ^XMB(3.9,XMZ,2,L,0)="Item "_M1_" was not found in PO "_CC_"."
SET L=L+1
QUIT
+18 IF II=3
SET ^XMB(3.9,XMZ,2,L,0)="The Vendor Stock Number wasn't found in item "_M1_"."
SET L=L+1
QUIT
+19 IF II=5
SET ^XMB(3.9,XMZ,2,L,0)="There is no quantity listed for item "_M1_"."
SET L=L+1
QUIT
+20 IF II=6
SET ^XMB(3.9,XMZ,2,L,0)="There is no Unit of Purchase listed for item "_M1_"."
SET L=L+1
QUIT
+21 IF II=7
SET ^XMB(3.9,XMZ,2,L,0)="There is no Unit Cost listed for item "_M1_"."
SET L=L+1
QUIT
+22 IF II=9
SET ^XMB(3.9,XMZ,2,L,0)="The Vendor Stock Number from the POA doesn't match the one from item "_M1_"."
SET L=L+1
QUIT
+23 IF II=10
SET ^XMB(3.9,XMZ,2,L,0)="The Quantity listed in the POA doesn't match the one listed in item "_M1_"."
SET L=L+1
QUIT
+24 IF II=11
SET ^XMB(3.9,XMZ,2,L,0)="The Unit of Purchase listed in the POA doesn't match the one in item "_M1_"."
SET L=L+1
QUIT
+25 IF II=12
SET ^XMB(3.9,XMZ,2,L,0)="The Unit Cost listed in the POA doesn't match the one in item "_M1_"."
SET L=L+1
QUIT
+26 IF II=13
SET ^XMB(3.9,XMZ,2,L,0)="The POA for PO "_CC_" is missing a line item number."
SET L=L+1
QUIT
+27 QUIT
End DoDot:2
+28 QUIT
End DoDot:1
+29 if L=1
QUIT
+30 ;
SEND ; COME HERE TO SEND THE MAILMAN MESSAGE BUILT UP IN 'MSG' ABOVE.
+1 SET L=L-1
+2 SET ^XMB(3.9,XMZ,2,0)="^3.9A^"_L_"^"_L_"^"_DT
+3 SET XMDUN="IFCAP 'POA' PROBLEM"
+4 SET X="G.EDP"
+5 DO WHO^XMA21
+6 if '$LENGTH($ORDER(XMY("")))
SET XMY(.5)=""
+7 if $GET(PPM)]""
SET XMY(PPM)=""
+8 DO ENT1^XMD
+9 KILL XMY
+10 QUIT
+11 ;
BUL ; THIS BULLETIN WILL NOTIFY THAT A 'POA' TRANSACTION HAS ARRIVED
+1 ; FROM AUSTIN.
+2 NEW XMDUZ,XMB,DATE,X,Y,XMB,%,%DT
+3 SET XMDUZ="POA Server Interface"
+4 SET XMB="PRCOEDI ACKNOWLEDGE"
+5 DO NOW^%DTC
+6 SET Y=%
+7 SET %DT="S"
+8 DO DD^%DT
+9 SET XMB(3)=$PIECE(Y,"@")
+10 SET XMB(4)=$PIECE(Y,"@",2)
+11 SET XMB(5)=CC
+12 SET DATE=$PIECE(LINE,U,5)
+13 SET X1=$EXTRACT(DATE,1,4)-1700_"0101"
+14 SET X2=+$EXTRACT(DATE,5,7)-1
+15 DO C^%DTC
+16 SET Y=X_"."_$PIECE(LINE,U,6)
+17 DO DD^%DT
+18 SET XMB(1)=Y
+19 SET XMB(2)=$PIECE(LINE,U,3)
+20 SET XMY(PPM)=""
+21 DO ^XMB
+22 QUIT
+23 ;
DATE(DATE) ; THIS EXTRINSIC FUNCTION WILL RETURN THE DATE IN YYYYJJJ FORMAT
+1 ; WHERE YYYY IS 4 DIGIT YEAR AND JJJ IS THE DAY OF THE YEAR.
+2 ;
+3 ; THE INPUT PARAMETER, DATE, IS THE DATE TO CONVERT ENTERED IN
+4 ; VA FILEMAN FORMAT WITHOUT ANY TIME. THE DATE MUST CONTAIN
+5 ; YEAR, MONTH AND DAY.
+6 ;
+7 NEW X,%Y
+8 SET X1=DATE
+9 SET X2=$EXTRACT(DATE,1,3)_"0101"
+10 DO ^%DTC
+11 SET X=X+1
+12 SET X="000"_X
+13 SET X=$EXTRACT(X,$LENGTH(X)-2,99)
+14 QUIT $EXTRACT(DATE,1,3)+1700_X
+15 ;
TEXT(ENTRY,M1,CC) ; HOW TO RETRIEVE TEXT OF ERROR LISTINGS AND INCLUDE IN
+1 ; THEM THE
+2 ; 'LINE ITEM NUMBER' ALONG WITH THE 'PURCHASE ORDER NUMBER' AS
+3 ; NEEDED.
+4 ;
+5 ; Call this entry as an EXTRINSIC FUNCTION call.
+6 ; S AA=$$TEXT^PRCOESE1(ENTRY,M1,CC)
+7 ;
+8 ; On completion of function call AA will contain the text in PRCOER.
+9 ;
+10 ; INPUT PARAMETERS WHAT THEY MEAN
+11 ; ENTRY THE '^' SEPARATED PIECE THAT HAS A '*'
+12 ; FROM THE ERR(CC,B) ARRAY CREATED IN
+13 ; PRCOESE.
+14 ; M1 THE 'B' FROM THE ARRAY. THE 'LINE
+15 ; ITEM NUMBER' OF THE PO RECORD FROM THE
+16 ; 'POA' TRANSACTION BEING ENTERED.
+17 ; CC THE 'PURCHASE ORDER NUMBER' FROM THE 'POA'
+18 ; TRANSACTION BEING ENTERED.
+19 ;
+20 ; OUTPUT PARAMETER WHAT IT MEANS
+21 ; PRCOER THIS IS THE TEXT FROM 'LINES' WITH 'M1'
+22 ; AND 'CC' REPLACED WITH THEIR VALUES.
+23 ;
+24 NEW PRCOER
+25 ;
+26 ; POINT TO THE CORRECT LOCATION FOR THE LINE WANTED.
+27 ;
+28 SET PRCOER=""
+29 IF ENTRY=""
QUIT PRCOER
+30 ;
+31 ; GET THE TEXT WITHIN THE LINE.
+32 ;
+33 SET PRCOER=$PIECE($TEXT(LINES+ENTRY),";;",2)
+34 ;
+35 ; NOW LETS RESOLVE ALL VARIAVLES WITHIN THE LINE TO ITS ACTUAL TEXT.
+36 ; START AFTER THE SECOND QUOTATION MARK (") AND REPLACE ALL VARIABLES
+37 ; WITH THE VALUE (TEXT) OF THE VARIABLE.
+38 ;
+39 IF PRCOER["_M1_"
SET PRCOER=$PIECE(PRCOER,"_M1_")_M1_$PIECE(PRCOER,"_M1_",2)
+40 IF PRCOER["_CC_"
SET PRCOER=$PIECE(PRCOER,"_CC_")_CC_$PIECE(PRCOER,"_CC_",2)
+41 QUIT PRCOER
+42 ;
LINES ;Error messages
+1 ;;
+2 ;;Item _M1_ was not found in PO _CC_.
+3 ;;The Vendor Stock Number wasn't found in item _M1_.
+4 ;;
+5 ;;There is no quantity listed for item _M1_.
+6 ;;There is no Unit of Purchase listed for item _M1_.
+7 ;;There is no Unit Cost listed for item _M1_.
+8 ;;
+9 ;;The Vendor Stock Number from the POA doesn't match the one from item _M1_.
+10 ;;The Quantity listed in the POA doesn't match the one listed in item _M1_.
+11 ;;The Unit of Purchase listed in the POA doesn't match the one in item _M1_.
+12 ;;The Unit Cost listed in the POA doesn't match the one in item _M1_.
+13 ;;The POA for PO _CC_ is missing a line item number.
