PRCOINV1 ;WISC/DJM/LEM-INV Server Interface to IFCAP ;11/29/93 08:17
V ;;5.1;IFCAP;;Oct 20, 2000
;Per VHA Directive 10-93-142, this routine should not be modified.
MSG S M1="" F S M1=$O(ERR(CC,M1)) Q:M1="" Q:ERR(CC,M1)]""
Q:M1=""
S XMSUB="IFCAP 'INV' for Purchase Order "_CC,XMDUZ="IFCAP 'INV' SERVER" F I=1:1:5 D GET^XMA2 I I<5 Q:XMZ>0
I I=5,XMZ<1 Q ;MIGHT NEED TO REDO 'GET^XMA2' IF I=5 AND THERE IS NO XMZ.
S M1="",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 CI file.",L=L+1
.I M1>0,$P(ERR(CC,M1),U,2,99)]"" F II=2:1:12 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 CI "_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 INV 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 INV 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 INV 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 INV doesn't match the one in item "_M1_".",L=L+1 Q
..Q
.Q
Q:L=1 S L=L-1,^XMB(3.9,XMZ,2,0)="^3.9A^"_L_"^"_L_"^"_DT
S XMDUN="IFCAP 'INV' PROBLEM",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 'INV' TRANSACTION HAS ARRIVED FROM AUSTIN
N XMDUZ,XMB,DATE,X,Y,XMB,%,%DT
S XMDUZ="INV Server Interface",XMB="PRCOEDI ACKNOWLEDGE" D NOW^%DTC S Y=%,%DT="S" D DD^%DT S XMB(3)=$P(Y,"@"),XMB(4)=$P(Y,"@",2),XMB(5)=CC
S DATE=$P(LINE,U,5),X1=$E(DATE,1,4)-1700_"0101",X2=+$E(DATE,5,7)-1 D C^%DTC S Y=X_"."_$P(LINE,U,6) D DD^%DT S XMB(1)=Y,XMB(2)=$P(LINE,U,3) D ^XMB Q
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, 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,X2=$E(DATE,1,3)_"0101" D ^%DTC S X=X+1,X="000"_X,X=$E(X,$L(X)-2,99) Q $E(DATE,1,3)+1700_X
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCOINV1 2612 printed Sep 23, 2025@19:48:06 Page 2
PRCOINV1 ;WISC/DJM/LEM-INV Server Interface to IFCAP ;11/29/93 08:17
V ;;5.1;IFCAP;;Oct 20, 2000
+1 ;Per VHA Directive 10-93-142, this routine should not be modified.
MSG SET M1=""
FOR
SET M1=$ORDER(ERR(CC,M1))
if M1=""
QUIT
if ERR(CC,M1)]""
QUIT
+1 if M1=""
QUIT
+2 SET XMSUB="IFCAP 'INV' for Purchase Order "_CC
SET XMDUZ="IFCAP 'INV' SERVER"
FOR I=1:1:5
DO GET^XMA2
IF I<5
if XMZ>0
QUIT
+3 ;MIGHT NEED TO REDO 'GET^XMA2' IF I=5 AND THERE IS NO XMZ.
IF I=5
IF XMZ<1
QUIT
+4 SET M1=""
SET L=1
FOR
SET M1=$ORDER(ERR(CC,M1))
if M1=""
QUIT
IF ERR(CC,M1)]""
Begin DoDot:1
+5 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 CI file."
SET L=L+1
+6 IF M1>0
IF $PIECE(ERR(CC,M1),U,2,99)]""
FOR II=2:1:12
SET BB=$PIECE(ERR(CC,M1),U,II)
IF BB]""
Begin DoDot:2
+7 IF II=2
SET ^XMB(3.9,XMZ,2,L,0)="Item "_M1_" was not found in CI "_CC_"."
SET L=L+1
QUIT
+8 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
+9 IF II=5
SET ^XMB(3.9,XMZ,2,L,0)="There is no quantity listed for item "_M1_"."
SET L=L+1
QUIT
+10 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
+11 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
+12 IF II=9
SET ^XMB(3.9,XMZ,2,L,0)="The Vendor Stock Number from the INV doesn't match the one from item "_M1_"."
SET L=L+1
QUIT
+13 IF II=10
SET ^XMB(3.9,XMZ,2,L,0)="The Quantity listed in the INV doesn't match the one listed in item "_M1_"."
SET L=L+1
QUIT
+14 IF II=11
SET ^XMB(3.9,XMZ,2,L,0)="The Unit of Purchase listed in the INV doesn't match the one in item "_M1_"."
SET L=L+1
QUIT
+15 IF II=12
SET ^XMB(3.9,XMZ,2,L,0)="The Unit Cost listed in the INV doesn't match the one in item "_M1_"."
SET L=L+1
QUIT
+16 QUIT
End DoDot:2
+17 QUIT
End DoDot:1
+18 if L=1
QUIT
SET L=L-1
SET ^XMB(3.9,XMZ,2,0)="^3.9A^"_L_"^"_L_"^"_DT
+19 SET XMDUN="IFCAP 'INV' PROBLEM"
SET X="G.EDP"
DO WHO^XMA21
if '$LENGTH($ORDER(XMY("")))
SET XMY(.5)=""
if $GET(PPM)]""
SET XMY(PPM)=""
DO ENT1^XMD
KILL XMY
QUIT
BUL ;THIS BULLETIN WILL NOTIFY THAT A 'INV' TRANSACTION HAS ARRIVED FROM AUSTIN
+1 NEW XMDUZ,XMB,DATE,X,Y,XMB,%,%DT
+2 SET XMDUZ="INV Server Interface"
SET XMB="PRCOEDI ACKNOWLEDGE"
DO NOW^%DTC
SET Y=%
SET %DT="S"
DO DD^%DT
SET XMB(3)=$PIECE(Y,"@")
SET XMB(4)=$PIECE(Y,"@",2)
SET XMB(5)=CC
+3 SET DATE=$PIECE(LINE,U,5)
SET X1=$EXTRACT(DATE,1,4)-1700_"0101"
SET X2=+$EXTRACT(DATE,5,7)-1
DO C^%DTC
SET Y=X_"."_$PIECE(LINE,U,6)
DO DD^%DT
SET XMB(1)=Y
SET XMB(2)=$PIECE(LINE,U,3)
DO ^XMB
QUIT
+4 QUIT
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.
+1 ; THE INPUT, DATE, IS THE DATE TO CONVERT ENTERED IN VA FILEMAN FORMAT WITHOUT ANY TIME. THE DATE MUST CONTAIN YEAR, MONTH AND DAY.
+2 NEW X,%Y
SET X1=DATE
SET X2=$EXTRACT(DATE,1,3)_"0101"
DO ^%DTC
SET X=X+1
SET X="000"_X
SET X=$EXTRACT(X,$LENGTH(X)-2,99)
QUIT $EXTRACT(DATE,1,3)+1700_X
