| 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
 | 
|---|