- 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 Mar 13, 2025@21:16:48 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
