1 | PRCFDE3 ;(WASH ISC)/LKG -RECHARGE AN INVOICE ;7/19/95 14:32
|
---|
2 | V ;;5.1;IFCAP;;Oct 20, 2000
|
---|
3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
---|
4 | RECHARGE ;Send Invoice to Service for Certification
|
---|
5 | S PRCF("X")="AS" D ^PRCFSITE G:'% RCHX
|
---|
6 | S DIC=421.5,DIC(0)="AEMNZ"
|
---|
7 | S DIC("S")="I $S("";5;10;""[("";""_$P(^(2),U)_"";""):1,1:0)"
|
---|
8 | D ^DIC K DIC I Y<0 G RCHX
|
---|
9 | S PRCF("CIDA")=+Y,PRCF("LOC")=$P(^PRCF(421.5,PRCF("CIDA"),2),U,4)
|
---|
10 | L +^PRCF(421.5,PRCF("CIDA")):5 E W *7,!,"Invoice is being edited by another user - Please try again later!" G RC2
|
---|
11 | S DIR("A",1)="Invoice is currently in "_$S(PRCF("LOC")]"":PRCF("LOC"),1:"AN UNKNOWN LOCATION")_"."
|
---|
12 | S DIR("A")="Do you want to recharge it to someone else"
|
---|
13 | S DIR("B")="YES",DIR(0)="Y" D ^DIR K DIR
|
---|
14 | I Y'=1 S X=" <No Action Taken>*" D MSG^PRCFQ G RCHX:$D(DIRUT),RC1
|
---|
15 | S DIC=49,DIC(0)="AEMNZ",PRCF("LOC")=$P($G(^(+$P($G(^PRCF(421.5,PRCF("CIDA"),3,0)),U,3),0)),U),DIC("S")="I +Y'=PRCF(""LOC"")" D ^DIC K DIC
|
---|
16 | I Y<0 S X=" <No Action Taken>*" D MSG^PRCFQ G RCHX:$D(DTOUT)!$D(DUOUT),RC1
|
---|
17 | I $E($P(Y(0),"^",8),1,2)="04" S X="You may not RECHARGE a record to Fiscal. You may only CHECK-IN invoices to Fiscal. <No Action Taken>*" D MSG^PRCFQ G RC1
|
---|
18 | I '$$CHARGE(+Y,"",$P(Y(0),U,8)) S X=" <Recharge to Service Failed.>*" D MSG^PRCFQ G RC1
|
---|
19 | S X=" Recharge Completed.*" D MSG^PRCFQ
|
---|
20 | S X=5 D STATUS^PRCFDE1
|
---|
21 | RC1 L -^PRCF(421.5,PRCF("CIDA"))
|
---|
22 | RC2 K PRCF("CIDA"),PRCF("LOC")
|
---|
23 | G:$D(DTOUT) RCHX
|
---|
24 | S %A="Do you want to recharge another invoice",%B="",%=2 D ^PRCFYN
|
---|
25 | G RECHARGE:%=1
|
---|
26 | RCHX L:$D(PRCF("CIDA")) -^PRCF(421.5,PRCF("CIDA")) K PRCF,DTOUT,DUOUT,DIRUT
|
---|
27 | Q
|
---|
28 | LOGIN ;Check Certified Invoice into Fiscal
|
---|
29 | W !!,"This option allows you to check in documents from the services.",!,"It sets the current location as Fiscal and shows the status as",!,"'Awaiting Voucher Audit Review'.",!!
|
---|
30 | S %=1,%A="Do you wish to process each document as it is checked in",%B="If you answer 'YES', you will be prompted for the items necessary to"
|
---|
31 | S %B(1)="complete the Voucher Audit information.",%B(2)="A 'NO' will merely check-in the document.",%B(3)="Use an '^' to Quit." D ^PRCFYN G:%<0 LOGINX
|
---|
32 | S:%=1 PRCFD("ALL")=""
|
---|
33 | S PRCF("X")="AS" D ^PRCFSITE G:'% LOGINX
|
---|
34 | S DIC=49,DIC(0)="AEMNQZ",DIC("A")="Select Fiscal Section Accepting Receipt of Document: ",DIC("S")="I $E($P(^(0),""^"",8),1,2)=""04""" D ^DIC K DIC G:Y<0 LOGINX
|
---|
35 | S PRCF("FISCAL")=+Y,PRCF("MC")=$P(Y(0),U,8)
|
---|
36 | S DIC("A")="Select/Barcode INVOICE TRACKING NUMBER: "
|
---|
37 | NXT S DIC=421.5,DIC(0)="AEMNZ",DIC("S")="I $D(^(2)),+^(2)=5"
|
---|
38 | D ^DIC K DIC G:Y<0 LOGINX S PRCF("CIDA")=+Y
|
---|
39 | L +^PRCF(421.5,PRCF("CIDA")):5 E W *7,!,"Invoice is being edited by another user. - Please again try later!" G NXTX
|
---|
40 | W:$$CLSD1358^PRCFDE2($P(Y(0),U,7),1) !
|
---|
41 | I '$$CHARGE(PRCF("FISCAL"),10,PRCF("MC")) S X=" <Login Failed.>*" D MSG^PRCFQ G NXT1
|
---|
42 | I '$D(DTOUT),$D(PRCFD("ALL")) D DIE^PRCFDCI G NXT1
|
---|
43 | S X="Login completed.*" D MSG^PRCFQ
|
---|
44 | NXT1 L -^PRCF(421.5,PRCF("CIDA")) G:$D(DTOUT) LOGINX
|
---|
45 | NXTX S DIC("A")="Select/Barcode Next INVOICE TRACKING NUMBER: "
|
---|
46 | G NXT
|
---|
47 | LOGINX K DTOUT,DUOUT D OUT^PRCFDE
|
---|
48 | Q
|
---|
49 | CHARGE(PRCA,PRCB,PRCC) ;Assign to Certifying Service or Fiscal
|
---|
50 | ; PRCA Service's Internal Entry #, PRCB Invoice Status, PRCC Service's Mail Code
|
---|
51 | K DD,DO S DIC("P")=$P(^DD(421.5,70,0),U,2),DIC(0)="XL",DLAYGO=421.51
|
---|
52 | S DA(1)=PRCF("CIDA"),DIC="^PRCF(421.5,"_DA(1)_",3,"
|
---|
53 | S X=PRCA D FILE^DICN K DLAYGO I +Y<1 K DIC,DA Q 0
|
---|
54 | S DA=+Y,DA(1)=PRCF("CIDA"),DIE=DIC K DIC D NOW^PRCFQ K X,Y,%X
|
---|
55 | S DR="1////^S X=%;2////^S X=DUZ" D ^DIE K DIE,DR,DA
|
---|
56 | S DIE="^PRCF(421.5,",DA=PRCF("CIDA"),PRCC=$E(PRCC,1,2)
|
---|
57 | S DR=$S(PRCB'="":"50////^S X=PRCB;",1:"")_$S(PRCC="04":"58////^S X=$P(DT,""."");57///@",1:"58///@;57///T+7;57R")
|
---|
58 | D ^DIE K DIE,DR,DA I $E($G(IOST),1,2)="C-",PRCC'="04" W !
|
---|
59 | Q 1
|
---|