- 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 Feb 18, 2025@23:29:17 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