Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PRCFDE1

PRCFDE1.m

Go to the documentation of this file.
  1. PRCFDE1 ;WISC@ALTOONA/CTB-CONTINUATION OF PRCFDE ;12/2/10 16:13
  1. V ;;5.1;IFCAP;**154**;Oct 20, 2000;Build 5
  1. ;Per VHA Directive 2004-038, this routine should not be modified.
  1. K DIC S DIE="^PRCF(421.5,",DA=PRCF("CIDA")
  1. K %DT S X="T" D ^%DT S PRCFD("TODAY")=Y
  1. S DR="[PRCF CI VOUCHER AUDIT]" D ^DIE ;Q:$D(PRCFD("PAY"))
  1. D ENTER^PRCFDCIP
  1. K PRCF("VENDA"),PRCFD("DOI"),PRCFD("PODA"),PRCFD("DOP"),PRCFD("DIR")
  1. K PRCFD("INV TYPE"),PRCF("PTR"),PRCF("DAYS"),PRCF("NAME"),PRCF("X")
  1. K PRCF("PT"),PRCFD("DOD"),ZX
  1. I $D(Y) S X=$S($D(PRCFD("LOGIN")):10,1:0) D STATUS,NA G VEX
  1. D I %<0 D NA S PRCFD("^")="" G VEX
  1. . S %A="Accept invoice for further processing",%B="",%=1 D ^PRCFYN
  1. . Q:%'=2 S %A="Return invoice to vendor",%B="",%=2 D ^PRCFYN
  1. . Q:%<0 S:%=1 %=3
  1. . Q
  1. I %=2 S X=$S($D(PRCFD("LOGIN")):10,1:0) D STATUS,NA G VEX
  1. I %=3 D G VEX
  1. . S DR=25 D ^DIE I X D
  1. . . S DR="24//TODAY;23" D ^DIE,PRCFCHK^PRCFDCI,^PRCFDSUS
  1. . . Q
  1. . S X=3 D STATUS
  1. . Q
  1. G:$D(PRCFD("LOGIN"))&'$D(PRCFD("RECERT")) VEX
  1. I '$P(^PRCF(421.5,PRCF("CIDA"),0),"^",27) G PAYMENT
  1. S %A="Do you wish to forward this invoice for signature at this time",%B="",%=1 D ^PRCFYN
  1. I %'=1 S X=0,PRCF("%")=% D STATUS S X=" <No further action taken.>*" D MSG^PRCFQ S %=PRCF("%") K PRCF("%") S:%<0 PRCFD("^")="" G VEX
  1. S DIE="^PRCF(421.5,",DA=PRCF("CIDA"),DR="[PRCF CI BORROWER]" D ^DIE
  1. I $D(Y) S X=0 D STATUS,NA S PRCFD("^")="" G VEX
  1. S X="Please forward actual invoice to service for signature.*"
  1. D MSG^PRCFQ S X=5 D STATUS
  1. VEX Q
  1. ;
  1. PAYMENT S %A="Do you wish to process this item for payment now",%B="",%=1
  1. N PRCYESNO
  1. D ^PRCFYN S PRCYESNO=%
  1. I PRCYESNO=1,$$VIOLATE^PRCFDSOD(PRCF("CIDA"),DUZ) S X=10 D STATUS,NA G PAYX
  1. I PRCYESNO'=1 S X=10 S:%<0 PRCFD("^")="" D STATUS,NA G PAYX
  1. D DIE^PRCFDCI
  1. PAYX Q
  1. STATUS N X1,X2,DA,DIE,DR S X2=X
  1. S X1=$S($D(^PRCF(421.5,PRCF("CIDA"),2))#2:$P(^(2),"^"),1:"")
  1. I X1="" D ST S X="Status is set to '"_Y_"'.*" D MSG^PRCFQ G STATUSX
  1. I X=X1 D ST S X="Status of '"_Y_"' has not been changed.*" D MSG^PRCFQ Q
  1. S X=X1 D ST S $P(X1,"^",2)=Y,X=X2 D ST S $P(X2,"^",2)=Y
  1. S X="Status has been changed from '"_$P(X1,"^",2)_"'*" D MSG^PRCFQ
  1. S X=" to '"_$P(X2,"^",2)_"'.*" D MSG^PRCFQ
  1. I $G(PRCNOPAT)=1 K PRCNOPAT W ?3,"This invoice needs a valid purchase order number.",!!
  1. STATUSX S DA=PRCF("CIDA"),DR="50////^S X=+X2",DIE=421.5 D ^DIE
  1. Q
  1. ST N DD,F S DD=421.5,F=50 D ^PRCFU1 Q
  1. NA S X=" <No action taken.>*" D MSG^PRCFQ Q
  1. OUT ;EXIT LINE
  1. D OUT^PRCFDE Q
  1. EDIT ;EDIT EXISTING, INCOMPLETE INVOICE
  1. S PRCF("X")="AS" D ^PRCFSITE Q:'%
  1. S PRCFD("PAY")="",PRCFDX("ED")="",DIC=421.5,DIC(0)="AEMNZ"
  1. S DIC("S")="I $S('$D(^(2)):1,+^(2)>3:0,1:1),$D(^(1)),$P(^(1),""^"",2)=PRC(""SITE"")"
  1. D ^DIC K DIC I Y<0 K PRCFDX("ED") D OUT Q
  1. S PRCF("CIDA")=+Y D PAT^PRCFDE I $D(PRCFD("^")) D OUT Q
  1. S %A="Do you wish to edit another incomplete invoice",%B="",%=2
  1. D ^PRCFYN G EDIT:%=1 D OUT
  1. Q
  1. ;
  1. ;
  1. PO ;INPUT TRANSFORM FOR FIELD 4.5 FILE 421.5
  1. ;I '$D(PRC("SITE")) S PRCFX=X,PRCF("X")="AS" D ^PRCFSITE S X=PRCFX K PRCFX Q:'%
  1. I X["." S X=$P(X,".")
  1. N DIC,%A,%B S DIC=442,DIC(0)="EM" D ^DIC K DIC
  1. I $D(DTOUT)!($D(DUOUT)) K DTOUT,DUOUT,X Q
  1. I Y>0 S ZY=Y,X=$P($G(^PRC(442,+Y,7)),U,2) I X<10!(X>43) G:X=45 CANC D QUES,^PRCFYN S Y=ZY K ZY I %'=1 K X Q
  1. I $G(PRCF("CIDA"))="" S PRCF("CIDA")=$G(DA)
  1. I Y>0 S X=$P(Y,"^",2),$P(^PRCF(421.5,PRCF("CIDA"),0),"^",7)=+Y,^PRCF(421.5,"E",+Y,PRCF("CIDA"))="" Q
  1. I Y<0,X="" K X Q
  1. S X=$S(X["-":PRC("SITE")_"-"_$P(X,"-",2),1:PRC("SITE")_"-"_X)
  1. S %A=$S(X]"":"PAT Reference Number "_X_" is not in Purchase Order File.",1:"No PAT number selected"),%A(0)="*!",%A(1)="OK to Continue",%B="",%=2 D ^PRCFYN I %'=1 K X Q
  1. I %=1 S PRCNOPAT=1
  1. N PZ
  1. S PZ=$P(^PRCF(421.5,PRCF("CIDA"),0),"^",7),$P(^(0),"^",7)=""
  1. I PZ]"" K ^PRCF(421.5,"E",PZ,PRCF("CIDA")) Q
  1. Q
  1. QUES S X=+$G(^PRC(442,+Y,7))
  1. S X=$S(X="":"UNKNOWN",'$D(^PRCD(442.3,X,0)):"UNKNOWN",1:$P(^(0),"^"))
  1. S %A="Current Status on this PAT number is '"_X_"'. OK to Continue"
  1. S %A(0)="*",%B="",%=2
  1. Q
  1. CANC W !,$C(7),"Purchase Order status is: CANCELED ORDER. Cannot proceed." S Y=ZY,%=-1 K ZY,X Q