- PRCFDE ;WISC/CTB/CLH/BGJ-ENTER/EDIT CERTIFIED INVOICE ; 9/28/99 11:30am
- V ;;5.1;IFCAP;;Oct 20, 2000
- ;Per VHA Directive 10-93-142, this routine should not be modified.
- DE I '$D(PRC("SITE")) S PRCF("X")="AS" D ^PRCFSITE Q:'$D(PRC("SITE"))
- S DIC=421.5,DIC("S")="I $P(^(2),U)=0",DIC(0)="AEMNQ"
- S DIC("A")="Select CERTIFIED INVOICE: "
- D ^DIC K DIC Q:+Y<0 S PRCF("CIDA")=+Y
- S %A="Are you SURE you want to delete this record",%B="",%=2
- D ^PRCFYN I %'=1 S X=" <Nothing deleted.>*" D MSG^PRCFQ,OUT Q
- DEL ;DELETE INDIVIDUAL CERTIFIED INVOICE RECORD
- S DA=PRCF("CIDA"),DIK="^PRCF(421.5," D ^DIK K DIK
- S X="Certified Invoice Record Deleted*" D MSG^PRCFQ
- OUT ;EXIT LINE
- K %,C,DA,DIC,DIE,DLAYGO,DR,F,J,N,PRCF,PRCFD,PRCFCK,PRCHPO,X,X1,Y,Z,D0
- Q
- OUT1 D NA^PRCFDE1 S X=0 D STATUS^PRCFDE1,OUT Q
- CREATE ;ASSIGN NEXT NUMBER
- S X=$P(^PRCF(421.5,0),"^",3) F Y=X+1:1 L +^PRCF(421.5,Y):0 Q:$T&('$D(^PRCF(421.5,Y))) L -^PRCF(421.5,Y)
- S X=Y,DIC=421.5,DLAYGO=421.5,DIC(0)="ELZN",D="B" D IX^DIC K DLAYGO Q:Y<0
- S X=+Y L -^PRCF(421.5,X)
- Q
- QUES W $C(7),!,"You may:",!,"1. Scan a Certified Invoice Barcode Label or,",!,"2. Enter 'NEW' or 'NEXT' for auto assignment.",!!
- Q
- PT K PRCF("PODA"),PRCF("VENDA")
- N PRCFVEN
- S PRCFVEN=$P(^PRCF(421.5,PRCF("CIDA"),0),U,8) I $G(PRCFVEN)]"" D
- . K ^PRCF(421.5,"C",PRCFVEN,PRCF("CIDA"))
- . S $P(^PRCF(421.5,PRCF("CIDA"),0),U,8)=""
- S DIE="^PRCF(421.5,",DR="4.5Select PAT Number: ",DA=PRCF("CIDA")
- D ^DIE
- Q
- NEW ;ENTER NEW CERTIFIED INVOICE
- S PRCFNOPO=0
- S PRCF("X")="AS" D ^PRCFSITE Q:'%
- N1 S (PRCFD("NEW"),PRCFD("PAY"))="",Y=0
- R !,"Enter Invoice Tracking Number: ",X:DTIME
- G:'$T!(X["^")!(X="") OUT I $E(X)=" " W $C(7) G NEW
- I X["?" D QUES G N1
- S A="~NEW~New~new~NEXT~Next~next",Z="~"_X I X'?1.9N,A'[Z W $C(7)," Incorrect format." S X="Correct Format is 1 to 9 numbers or the words NEW or NEXT*" D MSG^PRCFQ D QUES G N1
- I A[Z D CREATE G:Y<0 NEW
- K Z,A I Y=0 S DIC=421.5,DLAYGO=421.5,DIC(0)="XZL" D ^DIC K DLAYGO I Y<0 S X="Unable to add "_X_" to the file. Try again.*" D MSG^PRCFQ W $C(7),$C(7),$C(7),$C(7) G NEW
- S X="Adding "_X_" to Invoice Tracking File.*" D MSG^PRCFQ
- N2 K DIC,DLAYGO I Y<0 K X,Y G OUT
- I '$P(Y,"^",3) S X="This is not a new Invoice Tracking Number. Use EDIT INCOMPLETE INVOICE Option if you wish to edit it.*" D MSG^PRCFQ G NEW
- S DA=+Y,PRCF("CIDA")=+Y,$P(^PRCF(421.5,DA,1),"^",2)=PRC("SITE")
- ;D ^PRCFDLN S $P(^PRCF(421.5,PRCF("CIDA"),0),"^",2)=PRCFDLN K PRCFDLN
- K PRCFX,DIC
- D PAT G:$D(PRCFD("^")) OUT
- S %A="Do you wish to enter another invoice",%B="",%=1 D ^PRCFYN
- G:%'=1 OUT D OUT G NEW
- PAT D PT I $D(Y) S %A="OK to Delete",%B="",%=1 D ^PRCFYN G:%=2 PAT D DEL Q
- S Y(0)=^PRCF(421.5,DA,0),Y(1)=$G(^(1))
- I $P(Y(1),"^",3)="" S X="PAT Number is REQUIRED.*" D MSG^PRCFQ
- I $P(Y(0),"^",7)="" S X="Purchase Order data will not be available for this payment.*" D MSG^PRCFQ S PRCFNOPO=1 G DIE
- S (PRCF("PODA"),D0)=$P(^PRCF(421.5,DA,0),"^",7)
- I $$CLSD1358^PRCFDE2(PRCF("PODA"),1) R !,"Hit <CR> to continue",X:DTIME
- D ^PRCFDSC1 S PRCF("VENDA")=$P($G(^PRCF(421.5,PRCF("CIDA"),0)),U,8)
- I $D(^PRC(442,PRCF("PODA"),1)),+^(1)>0 S PRCF("VENDA")=+^(1)
- S $P(^PRCF(421.5,PRCF("CIDA"),0),"^",7)=PRCF("PODA")
- I PRCF("VENDA")?1.N D
- . S DA=PRCF("CIDA"),DIE=421.5,DR="6////"_PRCF("VENDA")
- . D ^DIE K DA,DIE,DR
- S (X,PRCF("PO"))=$P(^PRC(442,PRCF("PODA"),0),"^")
- S $P(^PRCF(421.5,PRCF("CIDA"),2),"^",3)=X,$P(^(1),"^",3)=X
- D
- . S DIC=421.9,DIC(0)="Z",X=PRCF("PO") D ^DIC
- . I Y'<0,$P(Y(0),"^",2)>949 D W !! D MSG^PRCFQ W $C(7),$C(7),$C(7),$C(7)
- . . I $P(Y(0),"^",2)<974 S X="WARNING: This PO currently has "_$P(Y(0),"^",2)_" partials and is approaching the limit of 974 permitted by the system." Q
- . . I $P(Y(0),"^",2)=974 S X="WARNING: This PO currently has 974 partials, which is the limit permitted by the system. The addition of further partials will result in errors." D Q
- . . . S X=X_" If you proceed with the processing of this invoice in IFCAP, the PV document will have to be created on-line in FMS."
- . . S X="WARNING: This PO currently has "_$P(Y(0),"^",2)_" partials and has exceeded the limit of 974 permitted by the system. Corrective action must be taken." D Q
- . . . S X=X_" If you proceed with the processing of this invoice in IFCAP, the PV document will have to be created on-line in FMS."
- . K DIC,Y
- W !,$C(7) S %=2,%A="Do you need to view the entire PO",%B=""
- D ^PRCFYN I %<0 D OUT1 Q
- S D0=PRCF("PODA") I %=1 D ^PRCHDP1,^PRCFDSC1 W !,$C(7) K PRCHPO
- S %=1,%A="Is this the correct Purchase Order for this Invoice",%B=""
- D ^PRCFYN G PAT:%=2 I %<0 D OUT1 Q
- S %A="Do you want to review other Invoices for this Purchase Order"
- S %B="",%=2 D ^PRCFYN I %<0 D OUT1 Q
- D:%=1 PO^PRCFDIC
- VEN ;
- D
- . S X=$O(^PRC(442,PRCF("PODA"),5,0)) Q:X=""
- . S X1=$G(^PRC(442,PRCF("PODA"),5,X,0))
- . S PRCF("%")=$P(X1,"^"),PRCF("DAYS")=$P(X1,"^",2)
- . S:+X1>0 $P(^PRCF(421.5,PRCF("CIDA"),0),"^",11,12)=PRCF("%")_"^"_PRCF("DAYS")
- . S:$E(X1,1,3)="NET" $P(^PRCF(421.5,PRCF("CIDA"),1),"^",10)=PRCF("DAYS")
- . Q
- S $P(^PRCF(421.5,PRCF("CIDA"),0),U,6)=$P($G(^PRC(442,PRCF("PODA"),12)),U,15)
- I +$P($G(^PRC(442,PRCF("PODA"),1)),U) D I %'=1 D VENED^PRCFDCI
- . S %A="Is this the correct Vendor for this Invoice",%B="",%=1
- . D ^PRCFYN
- I '$P($G(^PRC(442,PRCF("PODA"),1)),U) D I PRCF("VENDA")'?1.N W !,"Terminating Edit." D OUT Q
- . S DIC=440,DIC(0)="AENMQ" S:$P($G(^PRC(411,PRC("SITE"),0)),U,20) DIC(0)=DIC(0)_"L",DLAYGO=440
- . S DIC("A")="Invoice's Vendor: " S:PRCF("VENDA")?1.N DIC("B")=$P($G(^PRC(440,PRCF("VENDA"),0)),U)
- . D ^DIC K DIC,DLAYGO,ORDER,PRCHOV3,STATE Q:+Y<1 S PRCF("VENDA")=+Y
- . I $P(Y,U,3) S PRCF("NUVEND")=1 D VENDOR^PRCFDE2
- . S DIE=421.5,DR="6////"_PRCF("VENDA"),DA=PRCF("CIDA") D ^DIE
- . K DA,DR,DIE
- I +$G(PRCF("VENDA")),'$G(PRCF("NUVEND")) S %A="Do you want to edit this Vendor's information",%B="",%=2 D ^PRCFYN G OUT:%<1 D:%=1 VENDOR^PRCFDE2
- VL ;
- S %A="Do you want to review other Invoices for this VENDOR"
- S %B="",%=2 D ^PRCFYN I %<0 D OUT1 Q
- D:%=1 VENDOR^PRCFDIC
- DIE G ^PRCFDE1
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCFDE 6064 printed Jan 18, 2025@03:04:07 Page 2
- PRCFDE ;WISC/CTB/CLH/BGJ-ENTER/EDIT CERTIFIED INVOICE ; 9/28/99 11:30am
- V ;;5.1;IFCAP;;Oct 20, 2000
- +1 ;Per VHA Directive 10-93-142, this routine should not be modified.
- DE IF '$DATA(PRC("SITE"))
- SET PRCF("X")="AS"
- DO ^PRCFSITE
- if '$DATA(PRC("SITE"))
- QUIT
- +1 SET DIC=421.5
- SET DIC("S")="I $P(^(2),U)=0"
- SET DIC(0)="AEMNQ"
- +2 SET DIC("A")="Select CERTIFIED INVOICE: "
- +3 DO ^DIC
- KILL DIC
- if +Y<0
- QUIT
- SET PRCF("CIDA")=+Y
- +4 SET %A="Are you SURE you want to delete this record"
- SET %B=""
- SET %=2
- +5 DO ^PRCFYN
- IF %'=1
- SET X=" <Nothing deleted.>*"
- DO MSG^PRCFQ
- DO OUT
- QUIT
- DEL ;DELETE INDIVIDUAL CERTIFIED INVOICE RECORD
- +1 SET DA=PRCF("CIDA")
- SET DIK="^PRCF(421.5,"
- DO ^DIK
- KILL DIK
- +2 SET X="Certified Invoice Record Deleted*"
- DO MSG^PRCFQ
- OUT ;EXIT LINE
- +1 KILL %,C,DA,DIC,DIE,DLAYGO,DR,F,J,N,PRCF,PRCFD,PRCFCK,PRCHPO,X,X1,Y,Z,D0
- +2 QUIT
- OUT1 DO NA^PRCFDE1
- SET X=0
- DO STATUS^PRCFDE1
- DO OUT
- QUIT
- CREATE ;ASSIGN NEXT NUMBER
- +1 SET X=$PIECE(^PRCF(421.5,0),"^",3)
- FOR Y=X+1:1
- LOCK +^PRCF(421.5,Y):0
- if $TEST&('$DATA(^PRCF(421.5,Y)))
- QUIT
- LOCK -^PRCF(421.5,Y)
- +2 SET X=Y
- SET DIC=421.5
- SET DLAYGO=421.5
- SET DIC(0)="ELZN"
- SET D="B"
- DO IX^DIC
- KILL DLAYGO
- if Y<0
- QUIT
- +3 SET X=+Y
- LOCK -^PRCF(421.5,X)
- +4 QUIT
- QUES WRITE $CHAR(7),!,"You may:",!,"1. Scan a Certified Invoice Barcode Label or,",!,"2. Enter 'NEW' or 'NEXT' for auto assignment.",!!
- +1 QUIT
- PT KILL PRCF("PODA"),PRCF("VENDA")
- +1 NEW PRCFVEN
- +2 SET PRCFVEN=$PIECE(^PRCF(421.5,PRCF("CIDA"),0),U,8)
- IF $GET(PRCFVEN)]""
- Begin DoDot:1
- +3 KILL ^PRCF(421.5,"C",PRCFVEN,PRCF("CIDA"))
- +4 SET $PIECE(^PRCF(421.5,PRCF("CIDA"),0),U,8)=""
- End DoDot:1
- +5 SET DIE="^PRCF(421.5,"
- SET DR="4.5Select PAT Number: "
- SET DA=PRCF("CIDA")
- +6 DO ^DIE
- +7 QUIT
- NEW ;ENTER NEW CERTIFIED INVOICE
- +1 SET PRCFNOPO=0
- +2 SET PRCF("X")="AS"
- DO ^PRCFSITE
- if '%
- QUIT
- N1 SET (PRCFD("NEW"),PRCFD("PAY"))=""
- SET Y=0
- +1 READ !,"Enter Invoice Tracking Number: ",X:DTIME
- +2 if '$TEST!(X["^")!(X="")
- GOTO OUT
- IF $EXTRACT(X)=" "
- WRITE $CHAR(7)
- GOTO NEW
- +3 IF X["?"
- DO QUES
- GOTO N1
- +4 SET A="~NEW~New~new~NEXT~Next~next"
- SET Z="~"_X
- IF X'?1.9N
- IF A'[Z
- WRITE $CHAR(7)," Incorrect format."
- SET X="Correct Format is 1 to 9 numbers or the words NEW or NEXT*"
- DO MSG^PRCFQ
- DO QUES
- GOTO N1
- +5 IF A[Z
- DO CREATE
- if Y<0
- GOTO NEW
- +6 KILL Z,A
- IF Y=0
- SET DIC=421.5
- SET DLAYGO=421.5
- SET DIC(0)="XZL"
- DO ^DIC
- KILL DLAYGO
- IF Y<0
- SET X="Unable to add "_X_" to the file. Try again.*"
- DO MSG^PRCFQ
- WRITE $CHAR(7),$CHAR(7),$CHAR(7),$CHAR(7)
- GOTO NEW
- +7 SET X="Adding "_X_" to Invoice Tracking File.*"
- DO MSG^PRCFQ
- N2 KILL DIC,DLAYGO
- IF Y<0
- KILL X,Y
- GOTO OUT
- +1 IF '$PIECE(Y,"^",3)
- SET X="This is not a new Invoice Tracking Number. Use EDIT INCOMPLETE INVOICE Option if you wish to edit it.*"
- DO MSG^PRCFQ
- GOTO NEW
- +2 SET DA=+Y
- SET PRCF("CIDA")=+Y
- SET $PIECE(^PRCF(421.5,DA,1),"^",2)=PRC("SITE")
- +3 ;D ^PRCFDLN S $P(^PRCF(421.5,PRCF("CIDA"),0),"^",2)=PRCFDLN K PRCFDLN
- +4 KILL PRCFX,DIC
- +5 DO PAT
- if $DATA(PRCFD("^"))
- GOTO OUT
- +6 SET %A="Do you wish to enter another invoice"
- SET %B=""
- SET %=1
- DO ^PRCFYN
- +7 if %'=1
- GOTO OUT
- DO OUT
- GOTO NEW
- PAT DO PT
- IF $DATA(Y)
- SET %A="OK to Delete"
- SET %B=""
- SET %=1
- DO ^PRCFYN
- if %=2
- GOTO PAT
- DO DEL
- QUIT
- +1 SET Y(0)=^PRCF(421.5,DA,0)
- SET Y(1)=$GET(^(1))
- +2 IF $PIECE(Y(1),"^",3)=""
- SET X="PAT Number is REQUIRED.*"
- DO MSG^PRCFQ
- +3 IF $PIECE(Y(0),"^",7)=""
- SET X="Purchase Order data will not be available for this payment.*"
- DO MSG^PRCFQ
- SET PRCFNOPO=1
- GOTO DIE
- +4 SET (PRCF("PODA"),D0)=$PIECE(^PRCF(421.5,DA,0),"^",7)
- +5 IF $$CLSD1358^PRCFDE2(PRCF("PODA"),1)
- READ !,"Hit <CR> to continue",X:DTIME
- +6 DO ^PRCFDSC1
- SET PRCF("VENDA")=$PIECE($GET(^PRCF(421.5,PRCF("CIDA"),0)),U,8)
- +7 IF $DATA(^PRC(442,PRCF("PODA"),1))
- IF +^(1)>0
- SET PRCF("VENDA")=+^(1)
- +8 SET $PIECE(^PRCF(421.5,PRCF("CIDA"),0),"^",7)=PRCF("PODA")
- +9 IF PRCF("VENDA")?1.N
- Begin DoDot:1
- +10 SET DA=PRCF("CIDA")
- SET DIE=421.5
- SET DR="6////"_PRCF("VENDA")
- +11 DO ^DIE
- KILL DA,DIE,DR
- End DoDot:1
- +12 SET (X,PRCF("PO"))=$PIECE(^PRC(442,PRCF("PODA"),0),"^")
- +13 SET $PIECE(^PRCF(421.5,PRCF("CIDA"),2),"^",3)=X
- SET $PIECE(^(1),"^",3)=X
- +14 Begin DoDot:1
- +15 SET DIC=421.9
- SET DIC(0)="Z"
- SET X=PRCF("PO")
- DO ^DIC
- +16 IF Y'<0
- IF $PIECE(Y(0),"^",2)>949
- Begin DoDot:2
- +17 IF $PIECE(Y(0),"^",2)<974
- SET X="WARNING: This PO currently has "_$PIECE(Y(0),"^",2)_" partials and is approaching the limit of 974 permitted by the system."
- QUIT
- +18 IF $PIECE(Y(0),"^",2)=974
- SET X="WARNING: This PO currently has 974 partials, which is the limit permitted by the system. The addition of further partials will result in errors."
- Begin DoDot:3
- +19 SET X=X_" If you proceed with the processing of this invoice in IFCAP, the PV document will have to be created on-line in FMS."
- End DoDot:3
- QUIT
- +20 SET X="WARNING: This PO currently has "_$PIECE(Y(0),"^",2)_" partials and has exceeded the limit of 974 permitted by the system. Corrective action must be taken."
- Begin DoDot:3
- +21 SET X=X_" If you proceed with the processing of this invoice in IFCAP, the PV document will have to be created on-line in FMS."
- End DoDot:3
- QUIT
- End DoDot:2
- WRITE !!
- DO MSG^PRCFQ
- WRITE $CHAR(7),$CHAR(7),$CHAR(7),$CHAR(7)
- +22 KILL DIC,Y
- End DoDot:1
- +23 WRITE !,$CHAR(7)
- SET %=2
- SET %A="Do you need to view the entire PO"
- SET %B=""
- +24 DO ^PRCFYN
- IF %<0
- DO OUT1
- QUIT
- +25 SET D0=PRCF("PODA")
- IF %=1
- DO ^PRCHDP1
- DO ^PRCFDSC1
- WRITE !,$CHAR(7)
- KILL PRCHPO
- +26 SET %=1
- SET %A="Is this the correct Purchase Order for this Invoice"
- SET %B=""
- +27 DO ^PRCFYN
- if %=2
- GOTO PAT
- IF %<0
- DO OUT1
- QUIT
- +28 SET %A="Do you want to review other Invoices for this Purchase Order"
- +29 SET %B=""
- SET %=2
- DO ^PRCFYN
- IF %<0
- DO OUT1
- QUIT
- +30 if %=1
- DO PO^PRCFDIC
- VEN ;
- +1 Begin DoDot:1
- +2 SET X=$ORDER(^PRC(442,PRCF("PODA"),5,0))
- if X=""
- QUIT
- +3 SET X1=$GET(^PRC(442,PRCF("PODA"),5,X,0))
- +4 SET PRCF("%")=$PIECE(X1,"^")
- SET PRCF("DAYS")=$PIECE(X1,"^",2)
- +5 if +X1>0
- SET $PIECE(^PRCF(421.5,PRCF("CIDA"),0),"^",11,12)=PRCF("%")_"^"_PRCF("DAYS")
- +6 if $EXTRACT(X1,1,3)="NET"
- SET $PIECE(^PRCF(421.5,PRCF("CIDA"),1),"^",10)=PRCF("DAYS")
- +7 QUIT
- End DoDot:1
- +8 SET $PIECE(^PRCF(421.5,PRCF("CIDA"),0),U,6)=$PIECE($GET(^PRC(442,PRCF("PODA"),12)),U,15)
- +9 IF +$PIECE($GET(^PRC(442,PRCF("PODA"),1)),U)
- Begin DoDot:1
- +10 SET %A="Is this the correct Vendor for this Invoice"
- SET %B=""
- SET %=1
- +11 DO ^PRCFYN
- End DoDot:1
- IF %'=1
- DO VENED^PRCFDCI
- +12 IF '$PIECE($GET(^PRC(442,PRCF("PODA"),1)),U)
- Begin DoDot:1
- +13 SET DIC=440
- SET DIC(0)="AENMQ"
- if $PIECE($GET(^PRC(411,PRC("SITE"),0)),U,20)
- SET DIC(0)=DIC(0)_"L"
- SET DLAYGO=440
- +14 SET DIC("A")="Invoice's Vendor: "
- if PRCF("VENDA")?1.N
- SET DIC("B")=$PIECE($GET(^PRC(440,PRCF("VENDA"),0)),U)
- +15 DO ^DIC
- KILL DIC,DLAYGO,ORDER,PRCHOV3,STATE
- if +Y<1
- QUIT
- SET PRCF("VENDA")=+Y
- +16 IF $PIECE(Y,U,3)
- SET PRCF("NUVEND")=1
- DO VENDOR^PRCFDE2
- +17 SET DIE=421.5
- SET DR="6////"_PRCF("VENDA")
- SET DA=PRCF("CIDA")
- DO ^DIE
- +18 KILL DA,DR,DIE
- End DoDot:1
- IF PRCF("VENDA")'?1.N
- WRITE !,"Terminating Edit."
- DO OUT
- QUIT
- +19 IF +$GET(PRCF("VENDA"))
- IF '$GET(PRCF("NUVEND"))
- SET %A="Do you want to edit this Vendor's information"
- SET %B=""
- SET %=2
- DO ^PRCFYN
- if %<1
- GOTO OUT
- if %=1
- DO VENDOR^PRCFDE2
- VL ;
- +1 SET %A="Do you want to review other Invoices for this VENDOR"
- +2 SET %B=""
- SET %=2
- DO ^PRCFYN
- IF %<0
- DO OUT1
- QUIT
- +3 if %=1
- DO VENDOR^PRCFDIC
- DIE GOTO ^PRCFDE1