source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCFDE3.m@ 862

Last change on this file since 862 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 3.6 KB
RevLine 
[613]1PRCFDE3 ;(WASH ISC)/LKG -RECHARGE AN INVOICE ;7/19/95 14:32
2V ;;5.1;IFCAP;;Oct 20, 2000
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4RECHARGE ;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
21RC1 L -^PRCF(421.5,PRCF("CIDA"))
22RC2 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
26RCHX L:$D(PRCF("CIDA")) -^PRCF(421.5,PRCF("CIDA")) K PRCF,DTOUT,DUOUT,DIRUT
27 Q
28LOGIN ;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: "
37NXT 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
44NXT1 L -^PRCF(421.5,PRCF("CIDA")) G:$D(DTOUT) LOGINX
45NXTX S DIC("A")="Select/Barcode Next INVOICE TRACKING NUMBER: "
46 G NXT
47LOGINX K DTOUT,DUOUT D OUT^PRCFDE
48 Q
49CHARGE(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
Note: See TracBrowser for help on using the repository browser.