PRCFDE3 ;(WASH ISC)/LKG -RECHARGE AN INVOICE ;12/2/10 16:12
V ;;5.1;IFCAP;**154**;Oct 20, 2000;Build 5
;Per VHA Directive 2004-038, this routine should not be modified.
RECHARGE ;Send Invoice to Service for Certification
S PRCF("X")="AS" D ^PRCFSITE G:'% RCHX
S DIC=421.5,DIC(0)="AEMNZ"
S DIC("S")="I $S("";5;10;""[("";""_$P(^(2),U)_"";""):1,1:0)"
D ^DIC K DIC I Y<0 G RCHX
S PRCF("CIDA")=+Y,PRCF("LOC")=$P(^PRCF(421.5,PRCF("CIDA"),2),U,4)
L +^PRCF(421.5,PRCF("CIDA")):5 E W *7,!,"Invoice is being edited by another user - Please try again later!" G RC2
S DIR("A",1)="Invoice is currently in "_$S(PRCF("LOC")]"":PRCF("LOC"),1:"AN UNKNOWN LOCATION")_"."
S DIR("A")="Do you want to recharge it to someone else"
S DIR("B")="YES",DIR(0)="Y" D ^DIR K DIR
I Y'=1 S X=" <No Action Taken>*" D MSG^PRCFQ G RCHX:$D(DIRUT),RC1
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
I Y<0 S X=" <No Action Taken>*" D MSG^PRCFQ G RCHX:$D(DTOUT)!$D(DUOUT),RC1
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
I '$$CHARGE(+Y,"",$P(Y(0),U,8)) S X=" <Recharge to Service Failed.>*" D MSG^PRCFQ G RC1
S X=" Recharge Completed.*" D MSG^PRCFQ
S X=5 D STATUS^PRCFDE1
RC1 L -^PRCF(421.5,PRCF("CIDA"))
RC2 K PRCF("CIDA"),PRCF("LOC")
G:$D(DTOUT) RCHX
S %A="Do you want to recharge another invoice",%B="",%=2 D ^PRCFYN
G RECHARGE:%=1
RCHX L:$D(PRCF("CIDA")) -^PRCF(421.5,PRCF("CIDA")) K PRCF,DTOUT,DUOUT,DIRUT
Q
LOGIN ;Check Certified Invoice into Fiscal
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'.",!!
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"
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
S:%=1 PRCFD("ALL")=""
S PRCF("X")="AS" D ^PRCFSITE G:'% LOGINX
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
S PRCF("FISCAL")=+Y,PRCF("MC")=$P(Y(0),U,8)
S DIC("A")="Select/Barcode INVOICE TRACKING NUMBER: "
NXT S DIC=421.5,DIC(0)="AEMNZ",DIC("S")="I $D(^(2)),+^(2)=5"
D ^DIC K DIC G:Y<0 LOGINX S PRCF("CIDA")=+Y
I $$VIOLATE^PRCFDSOD(PRCF("CIDA"),DUZ) G NXTX
L +^PRCF(421.5,PRCF("CIDA")):5 E W *7,!,"Invoice is being edited by another user. - Please again try later!" G NXTX
W:$$CLSD1358^PRCFDE2($P(Y(0),U,7),1) !
I '$$CHARGE(PRCF("FISCAL"),10,PRCF("MC")) S X=" <Login Failed.>*" D MSG^PRCFQ G NXT1
I '$D(DTOUT),$D(PRCFD("ALL")) D DIE^PRCFDCI G NXT1
S X="Login completed.*" D MSG^PRCFQ
NXT1 L -^PRCF(421.5,PRCF("CIDA")) G:$D(DTOUT) LOGINX
NXTX S DIC("A")="Select/Barcode Next INVOICE TRACKING NUMBER: "
G NXT
LOGINX K DTOUT,DUOUT D OUT^PRCFDE
Q
CHARGE(PRCA,PRCB,PRCC) ;Assign to Certifying Service or Fiscal
; PRCA Service's Internal Entry #, PRCB Invoice Status, PRCC Service's Mail Code
K DD,DO S DIC("P")=$P(^DD(421.5,70,0),U,2),DIC(0)="XL",DLAYGO=421.51
S DA(1)=PRCF("CIDA"),DIC="^PRCF(421.5,"_DA(1)_",3,"
S X=PRCA D FILE^DICN K DLAYGO I +Y<1 K DIC,DA Q 0
S DA=+Y,DA(1)=PRCF("CIDA"),DIE=DIC K DIC D NOW^PRCFQ K X,Y,%X
S DR="1////^S X=%;2////^S X=DUZ" D ^DIE K DIE,DR,DA
S DIE="^PRCF(421.5,",DA=PRCF("CIDA"),PRCC=$E(PRCC,1,2)
S DR=$S(PRCB'="":"50////^S X=PRCB;",1:"")_$S(PRCC="04":"58////^S X=$P(DT,""."");57///@",1:"58///@;57///T+7;57R")
D ^DIE K DIE,DR,DA I $E($G(IOST),1,2)="C-",PRCC'="04" W !
Q 1
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCFDE3 3822 printed Apr 09, 2024@21:04:36 Page 2
PRCFDE3 ;(WASH ISC)/LKG -RECHARGE AN INVOICE ;12/2/10 16:12
V ;;5.1;IFCAP;**154**;Oct 20, 2000;Build 5
+1 ;Per VHA Directive 2004-038, this routine should not be modified.
RECHARGE ;Send Invoice to Service for Certification
+1 SET PRCF("X")="AS"
DO ^PRCFSITE
if '%
GOTO RCHX
+2 SET DIC=421.5
SET DIC(0)="AEMNZ"
+3 SET DIC("S")="I $S("";5;10;""[("";""_$P(^(2),U)_"";""):1,1:0)"
+4 DO ^DIC
KILL DIC
IF Y<0
GOTO RCHX
+5 SET PRCF("CIDA")=+Y
SET PRCF("LOC")=$PIECE(^PRCF(421.5,PRCF("CIDA"),2),U,4)
+6 LOCK +^PRCF(421.5,PRCF("CIDA")):5
IF '$TEST
WRITE *7,!,"Invoice is being edited by another user - Please try again later!"
GOTO RC2
+7 SET DIR("A",1)="Invoice is currently in "_$SELECT(PRCF("LOC")]"":PRCF("LOC"),1:"AN UNKNOWN LOCATION")_"."
+8 SET DIR("A")="Do you want to recharge it to someone else"
+9 SET DIR("B")="YES"
SET DIR(0)="Y"
DO ^DIR
KILL DIR
+10 IF Y'=1
SET X=" <No Action Taken>*"
DO MSG^PRCFQ
if $DATA(DIRUT)
GOTO RCHX
GOTO RC1
+11 SET DIC=49
SET DIC(0)="AEMNZ"
SET PRCF("LOC")=$PIECE($GET(^(+$PIECE($GET(^PRCF(421.5,PRCF("CIDA"),3,0)),U,3),0)),U)
SET DIC("S")="I +Y'=PRCF(""LOC"")"
DO ^DIC
KILL DIC
+12 IF Y<0
SET X=" <No Action Taken>*"
DO MSG^PRCFQ
if $DATA(DTOUT)!$DATA(DUOUT)
GOTO RCHX
GOTO RC1
+13 IF $EXTRACT($PIECE(Y(0),"^",8),1,2)="04"
SET X="You may not RECHARGE a record to Fiscal. You may only CHECK-IN invoices to Fiscal. <No Action Taken>*"
DO MSG^PRCFQ
GOTO RC1
+14 IF '$$CHARGE(+Y,"",$PIECE(Y(0),U,8))
SET X=" <Recharge to Service Failed.>*"
DO MSG^PRCFQ
GOTO RC1
+15 SET X=" Recharge Completed.*"
DO MSG^PRCFQ
+16 SET X=5
DO STATUS^PRCFDE1
RC1 LOCK -^PRCF(421.5,PRCF("CIDA"))
RC2 KILL PRCF("CIDA"),PRCF("LOC")
+1 if $DATA(DTOUT)
GOTO RCHX
+2 SET %A="Do you want to recharge another invoice"
SET %B=""
SET %=2
DO ^PRCFYN
+3 if %=1
GOTO RECHARGE
RCHX if $DATA(PRCF("CIDA"))
LOCK -^PRCF(421.5,PRCF("CIDA"))
KILL PRCF,DTOUT,DUOUT,DIRUT
+1 QUIT
LOGIN ;Check Certified Invoice into Fiscal
+1 WRITE !!,"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'.",!!
+2 SET %=1
SET %A="Do you wish to process each document as it is checked in"
SET %B="If you answer 'YES', you will be prompted for the items necessary to"
+3 SET %B(1)="complete the Voucher Audit information."
SET %B(2)="A 'NO' will merely check-in the document."
SET %B(3)="Use an '^' to Quit."
DO ^PRCFYN
if %<0
GOTO LOGINX
+4 if %=1
SET PRCFD("ALL")=""
+5 SET PRCF("X")="AS"
DO ^PRCFSITE
if '%
GOTO LOGINX
+6 SET DIC=49
SET DIC(0)="AEMNQZ"
SET DIC("A")="Select Fiscal Section Accepting Receipt of Document: "
SET DIC("S")="I $E($P(^(0),""^"",8),1,2)=""04"""
DO ^DIC
KILL DIC
if Y<0
GOTO LOGINX
+7 SET PRCF("FISCAL")=+Y
SET PRCF("MC")=$PIECE(Y(0),U,8)
+8 SET DIC("A")="Select/Barcode INVOICE TRACKING NUMBER: "
NXT SET DIC=421.5
SET DIC(0)="AEMNZ"
SET DIC("S")="I $D(^(2)),+^(2)=5"
+1 DO ^DIC
KILL DIC
if Y<0
GOTO LOGINX
SET PRCF("CIDA")=+Y
+2 IF $$VIOLATE^PRCFDSOD(PRCF("CIDA"),DUZ)
GOTO NXTX
+3 LOCK +^PRCF(421.5,PRCF("CIDA")):5
IF '$TEST
WRITE *7,!,"Invoice is being edited by another user. - Please again try later!"
GOTO NXTX
+4 if $$CLSD1358^PRCFDE2($PIECE(Y(0),U,7),1)
WRITE !
+5 IF '$$CHARGE(PRCF("FISCAL"),10,PRCF("MC"))
SET X=" <Login Failed.>*"
DO MSG^PRCFQ
GOTO NXT1
+6 IF '$DATA(DTOUT)
IF $DATA(PRCFD("ALL"))
DO DIE^PRCFDCI
GOTO NXT1
+7 SET X="Login completed.*"
DO MSG^PRCFQ
NXT1 LOCK -^PRCF(421.5,PRCF("CIDA"))
if $DATA(DTOUT)
GOTO LOGINX
NXTX SET DIC("A")="Select/Barcode Next INVOICE TRACKING NUMBER: "
+1 GOTO NXT
LOGINX KILL DTOUT,DUOUT
DO OUT^PRCFDE
+1 QUIT
CHARGE(PRCA,PRCB,PRCC) ;Assign to Certifying Service or Fiscal
+1 ; PRCA Service's Internal Entry #, PRCB Invoice Status, PRCC Service's Mail Code
+2 KILL DD,DO
SET DIC("P")=$PIECE(^DD(421.5,70,0),U,2)
SET DIC(0)="XL"
SET DLAYGO=421.51
+3 SET DA(1)=PRCF("CIDA")
SET DIC="^PRCF(421.5,"_DA(1)_",3,"
+4 SET X=PRCA
DO FILE^DICN
KILL DLAYGO
IF +Y<1
KILL DIC,DA
QUIT 0
+5 SET DA=+Y
SET DA(1)=PRCF("CIDA")
SET DIE=DIC
KILL DIC
DO NOW^PRCFQ
KILL X,Y,%X
+6 SET DR="1////^S X=%;2////^S X=DUZ"
DO ^DIE
KILL DIE,DR,DA
+7 SET DIE="^PRCF(421.5,"
SET DA=PRCF("CIDA")
SET PRCC=$EXTRACT(PRCC,1,2)
+8 SET DR=$SELECT(PRCB'="":"50////^S X=PRCB;",1:"")_$SELECT(PRCC="04":"58////^S X=$P(DT,""."");57///@",1:"58///@;57///T+7;57R")
+9 DO ^DIE
KILL DIE,DR,DA
IF $EXTRACT($GET(IOST),1,2)="C-"
IF PRCC'="04"
WRITE !
+10 QUIT 1
