PRCFDCI1 ;WISC@ALTOONA/CTB-APPROVE CHECKED IN INVOICE ;12/2/10 16:10
V ;;5.1;IFCAP;**154**;Oct 20, 2000;Build 5
;Per VHA Directive 2004-038, this routine should not be modified.
OUT K PRCFD("LOGIN"),PRCFDX("ED") D OUT^PRCFDE Q
CERT ;CERTIFY ALREADY CHECKED IN DOCUMENT
S PRCFD("LOGIN")="",PRCFDX("ED")=""
S PRCF("X")="AS" D ^PRCFSITE Q:'%
S DIC("A")="Select/Barcode INVOICE TRACKING NUMBER: "
C1 S DIC=421.5,DIC(0)="AEMNZ",DIC("S")="I $D(^(2)),+^(2)=10" D ^DIC K DIC G:Y<0 OUT
S (PRCF("CIDA"),DA)=+Y K PRCFD("RECERT")
I $$VIOLATE^PRCFDSOD(PRCF("CIDA"),DUZ) G OUT
W:$$CLSD1358^PRCFDE2($P(Y(0),U,7),1) !
S %A="Do you wish to edit any of the basic invoice information"
S %B="",%=2 D ^PRCFYN G OUT:%<0
I %=1 D PAT^PRCFDE W !! G:$D(PRCFD("^")) OUT
I $D(PRCF("CIDA")) D:'$D(PRCFD("RECERT")) DIE^PRCFDCI
S DIC("A")="Select/Barcode Next INVOICE TRACKING NUMBER: "
G OUT:$D(PRCFD("^")),C1
VIEW ;VIEW INDIVIDUAL CERTIFIED INVOICE
S PRCF("X")="AS" D ^PRCFSITE G OUTV:'%
S DIC=421.5,DIC(0)="AEMNZ" D ^DIC G OUTV:Y<0
S DA=+Y,%H=$H D YX^%DTC S Y=$P(Y,"@")_" "_$P($P(Y,"@",2),":",1,2) K %H
S X="" S:$D(IOM) $P(X,"-",IOM)=""
W @IOF,!,"INVOICE TRACKING LIST",?43,Y," ","PAGE 1",!,X
K X,DR S DIC="^PRCF(421.5,",DIQ(0)="C",PRCF("VIEW")="" D EN^DIQ K DIQ
D OUTV G VIEW
OUTV K DIC,DA,DR,PRCF,X,Y Q
CANC ;CANCEL CERTIFIED RECORD
;CURRENT STATUS MUST BE LESS THAN TRANSACTION COMPLETE
S PRCF("X")="AS" D ^PRCFSITE Q:'%
S DIC=421.5,DIC(0)="AEMN",DIC("S")="I $S('$D(^(2)):1,$P(^(2),U)<20:1,1:0)"
D ^DIC K DIC I +Y<0 D OUTV Q
S %A="Are you SURE that you want to cancel this record",%B="",%=2
D ^PRCFYN I %<0 D OUTV Q
I %=2 D OUTV G CANC
S (DA,PRCF("CIDA"))=+Y D WAIT^PRCFYN S X=$S($D(^PRCF(421.5,DA,2))'["0":$P(^(2),"^",6,8),1:"") S:X]"" $P(^(2),"^",6,8)="^^" S $P(^(0),"^",14,15)="0^0"
I $P(X,"^",3)]"" K ^PRCF(421.5,"AC",$P(X,"^",3),DA)
S X=25 D STATUS^PRCFDE1
S %A="Do you wish to cancel another Certified Invoice record",%B="",%=1
W ! D ^PRCFYN I %'=1 D OUTV Q
D OUTV G CANC
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCFDCI1 2033 printed Dec 13, 2024@02:02:53 Page 2
PRCFDCI1 ;WISC@ALTOONA/CTB-APPROVE CHECKED IN INVOICE ;12/2/10 16:10
V ;;5.1;IFCAP;**154**;Oct 20, 2000;Build 5
+1 ;Per VHA Directive 2004-038, this routine should not be modified.
OUT KILL PRCFD("LOGIN"),PRCFDX("ED")
DO OUT^PRCFDE
QUIT
CERT ;CERTIFY ALREADY CHECKED IN DOCUMENT
+1 SET PRCFD("LOGIN")=""
SET PRCFDX("ED")=""
+2 SET PRCF("X")="AS"
DO ^PRCFSITE
if '%
QUIT
+3 SET DIC("A")="Select/Barcode INVOICE TRACKING NUMBER: "
C1 SET DIC=421.5
SET DIC(0)="AEMNZ"
SET DIC("S")="I $D(^(2)),+^(2)=10"
DO ^DIC
KILL DIC
if Y<0
GOTO OUT
+1 SET (PRCF("CIDA"),DA)=+Y
KILL PRCFD("RECERT")
+2 IF $$VIOLATE^PRCFDSOD(PRCF("CIDA"),DUZ)
GOTO OUT
+3 if $$CLSD1358^PRCFDE2($PIECE(Y(0),U,7),1)
WRITE !
+4 SET %A="Do you wish to edit any of the basic invoice information"
+5 SET %B=""
SET %=2
DO ^PRCFYN
if %<0
GOTO OUT
+6 IF %=1
DO PAT^PRCFDE
WRITE !!
if $DATA(PRCFD("^"))
GOTO OUT
+7 IF $DATA(PRCF("CIDA"))
if '$DATA(PRCFD("RECERT"))
DO DIE^PRCFDCI
+8 SET DIC("A")="Select/Barcode Next INVOICE TRACKING NUMBER: "
+9 if $DATA(PRCFD("^"))
GOTO OUT
GOTO C1
VIEW ;VIEW INDIVIDUAL CERTIFIED INVOICE
+1 SET PRCF("X")="AS"
DO ^PRCFSITE
if '%
GOTO OUTV
+2 SET DIC=421.5
SET DIC(0)="AEMNZ"
DO ^DIC
if Y<0
GOTO OUTV
+3 SET DA=+Y
SET %H=$HOROLOG
DO YX^%DTC
SET Y=$PIECE(Y,"@")_" "_$PIECE($PIECE(Y,"@",2),":",1,2)
KILL %H
+4 SET X=""
if $DATA(IOM)
SET $PIECE(X,"-",IOM)=""
+5 WRITE @IOF,!,"INVOICE TRACKING LIST",?43,Y," ","PAGE 1",!,X
+6 KILL X,DR
SET DIC="^PRCF(421.5,"
SET DIQ(0)="C"
SET PRCF("VIEW")=""
DO EN^DIQ
KILL DIQ
+7 DO OUTV
GOTO VIEW
OUTV KILL DIC,DA,DR,PRCF,X,Y
QUIT
CANC ;CANCEL CERTIFIED RECORD
+1 ;CURRENT STATUS MUST BE LESS THAN TRANSACTION COMPLETE
+2 SET PRCF("X")="AS"
DO ^PRCFSITE
if '%
QUIT
+3 SET DIC=421.5
SET DIC(0)="AEMN"
SET DIC("S")="I $S('$D(^(2)):1,$P(^(2),U)<20:1,1:0)"
+4 DO ^DIC
KILL DIC
IF +Y<0
DO OUTV
QUIT
+5 SET %A="Are you SURE that you want to cancel this record"
SET %B=""
SET %=2
+6 DO ^PRCFYN
IF %<0
DO OUTV
QUIT
+7 IF %=2
DO OUTV
GOTO CANC
+8 SET (DA,PRCF("CIDA"))=+Y
DO WAIT^PRCFYN
SET X=$SELECT($DATA(^PRCF(421.5,DA,2))'["0":$PIECE(^(2),"^",6,8),1:"")
if X]""
SET $PIECE(^(2),"^",6,8)="^^"
SET $PIECE(^(0),"^",14,15)="0^0"
+9 IF $PIECE(X,"^",3)]""
KILL ^PRCF(421.5,"AC",$PIECE(X,"^",3),DA)
+10 SET X=25
DO STATUS^PRCFDE1
+11 SET %A="Do you wish to cancel another Certified Invoice record"
SET %B=""
SET %=1
+12 WRITE !
DO ^PRCFYN
IF %'=1
DO OUTV
QUIT
+13 DO OUTV
GOTO CANC
