PRCABP2 ;SF-ISC/YJK-PRINT 1080 BILL ;9/10/93 9:47 AM
V ;;4.5;Accounts Receivable;**104,112**;Mar 20, 1995
;;Per VHA Directive 10-93-142, this routine should not be modified.
S PRCA0=$S($D(^PRCA(430,D0,0)):^(0),1:""),PRCA10=$S($D(^(100)):^(100),1:""),PRCA14=$S($D(^(104)):^(104),1:"")
S PRCABN=D0,PRCA("DEBTNM")="",$P(PRCAUL,"_",97)="",U="^",CNT=0,PRCADFM=$S($D(PRCADFM):PRCADFM,1:0) S:IOBS="" IOBS="$C(8)"
ST W @IOF W !,"Standard Form 1080 (5-70)" W:$D(PRCAMEND) ?40,"AMENDED BILL" W ?75,"Voucher No. ",$S($P(PRCA10,U,4)]"":$P(PRCA10,U,4),1:"_________"),!?3,"2 Treasury FRM 2500",?35,"VOUCHER FOR TRANSFERS"
W !?3,"1080-108",?27,"BETWEEN APPROPRIATIONS AND/OR FUNDS",?75,"Schedule No.________"
W !,"Department or Establishment, Bureau or Office Billing: ",?75,"Bill No. ",$P(PRCA0,U,1) S Y=+$P(PRCA10,U,7) I '$D(^RC(342.1,Y,1)) W !! G ST1
S Y=$P($G(^RC(342.1,Y,0)),"^")_"^"_^RC(342.1,Y,1) W !?9,$P(Y,U,1) W:$P(Y,U,2)]"" !?9,$P(Y,U,2)
W:$P(Y,U,3)]"" !?9,$P(Y,U,3) W:$P(Y,U,4)]"" !?9,$P(Y,U,4)
W !?9,$P(Y,U,5),", ",$S($D(^DIC(5,+$P(Y,U,6),0)):$P(^(0),U,2),1:"")," ",$P(Y,U,7),!
ST1 W !,"Department or Establishment, Bureau or Office Billed: ",?75,"PAID BY:" D DEBTOR^PRCAUTL W !?12,PRCA("DEBTNM") I '$D(PRCA("DEBTOR")) W !!!
E W !?12,PRCAST1 W:PRCAST2]"" !?12,PRCAST2 W !?12,PRCACT,", ",PRCAST," ",PRCAKP,!
W ! D HDR S PRCAI=0,CNT=45
DES S PRCAI=$O(^PRCA(430,PRCABN,101,PRCAI)) G:'PRCAI ST2 S PRCAI0=^(PRCAI,0),PRCAD=0,DIWL=1,DIWR=40,DIWF="" K ^UTILITY($J,"W")
F I=0:0 S PRCAD=$O(^PRCA(430,PRCABN,101,PRCAI,1,PRCAD)) Q:'PRCAD S X=$S($D(^(PRCAD,0)):^(0),1:"") D ^DIWP
S J=$S($D(^UTILITY($J,"W",DIWL)):^(DIWL),1:0),CNT=CNT-1 D:CNT-6<0 NEWP,HDR
S Y=$P(PRCAI0,U,1) W $P(PRCAI0,U,7),?9,"|" D DT S PRCAKTM=""
I J F PRCAKK=1:1:(J-1) W:PRCAKK>1 ?9,"|" W ?18,"| ",^UTILITY($J,"W",DIWL,PRCAKK,0),?60,"|",?68,"|",?77,"|",?83,"|",! K PRCAKTM S CNT=CNT-1 D:CNT-6<0 NEWP,HDR
W:'$D(PRCAKTM) ?9,"|" W ?18,"|" W:$D(^UTILITY($J,"W",DIWL,J,0)) ^(0) W ?60,"|",$J($P(PRCAI0,U,3),7,$L($P($P(PRCAI0,U,3),".",2)))
W ?68,"|",$J($P(PRCAI0,U,4),8,$S($L($P($P(PRCAI0,U,4),".",2))>2:4,1:2))
W ?77,"| ",$S($D(^PRCD(420.5,+$P(PRCAI0,U,5),0)):$P(^(0),U,1),1:""),?83,"|",$J($P(PRCAI0,U,6),12,2)
K PRCAKTM D LF S CNT=CNT-2 G DES
ST2 S CNT=CNT-6 W PRCAUL,!,"Remittance in payment hereof should be sent to: ",?75,"TOTAL, $",$J($P(PRCA0,U,3),12,2),! S Y=$$SADD^RCFN01(1) I Y="" W !! G ST3
W !?8,"c/o Agent Cashier" W:$P(Y,U)]"" !?9,$P(Y,U) W:$P(Y,U,2)]"" !?9,$P(Y,U,2) W !?9,$P(Y,U,3),", ",$P(Y,U,4)," ",$P(Y,U,5)," ",$P(Y,U,6),!
ST3 S CNT=CNT-8 D:CNT<0 NEWP W PRCAUL,!
W ?30,"ACCOUNTING CLASSIFICATION - Billing Office",!,PRCAUL,! S I=0 F J=0:1 S I=$O(^PRCA(430,PRCABN,2,I)) Q:'I I $D(^(I,0)) S Y=^(0) W:$P(Y,U,4)]"" ?5,"APPROPRIATION: ",$P(Y,U,4)," $ ",$J($P(Y,U,2),12,2),!
F J=J:1:5 W ! I J=5,$P(PRCA14,U,2)]"",PRCADFM S DA=D0,P=+PRCA14,X=$P(PRCA14,U,2) D DE^PRCASIG(.X,P,DA_+$P(PRCA0,U,3)) W:X]"" "Approving Officer: /ES/ ",X," Date: " S Y=$P(PRCA14,U,3) D DT W !
S CNT=CNT-15 D:CNT<0 NEWP W PRCAUL,!?30,"CERTIFICATE OF OFFICE BILLED",!!,?5,"I certify that the above articles were received and accepted or the services performed as",!
W "stated and should be charged to the appropriation(s) and/or fund(s) as indicated below; or that,",!,"the advance payments requested is approved and should be paid as indicated.",!!
W $E(PRCAUL,1,30),?45,$E(PRCAUL,1,50),!,?12,"(Date)",?46,"(Authorized administrative or certifying officer)",!!,?45,$E(PRCAUL,1,50),!,?66,"(Title)",!,PRCAUL,!
W ?30,"ACCOUNTING CLASSIFICATION - Office Billed",!,PRCAUL,!!!!!,"Paid by Check No.: ",!
Q K CNT,D0,DA,PRCA,DIWF,DIWL,DIWR,I,J,PRCAKK,P,PRCA0,PRCA10,PRCA14,PRCABN,PRCACT,PRCAD,PRCADFM,PRCAI,PRCAI0,PRCAST,PRCAST1,PRCAST2,PRCAUL,PRCAKP,X,Y D:$D(ZTSK) KILL^%ZTLOAD K ZTSK Q
DT Q:Y="" W $$SLH^RCFN01(Y,"/") Q
HDR W !,PRCAUL,!,?9,"|",?18,"|",?60,"|",?68,"| Unit Price|",!,"ORDER NO.|",?11,"Date |",?28,"DESCRIPTION",?60,"| Qty | Cost | Per | Amount",?96 F I=1:1:97 W @IOBS
W PRCAUL S CNT=CNT-4
LF W !,?9,"|",?18,"|",?60,"|",?68,"|",?77,"|",?83,"|",! Q
NEWP W ?21,"CONTINUED ON NEXT PAGE",!,PRCAUL,@IOF,!!?5,"(CONTINUATION OF BILL)",?75,"Bill No. ",$P(PRCA0,U,1),!! S CNT=60 Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCABP2 4202 printed Apr 09, 2024@20:46:08 Page 2
PRCABP2 ;SF-ISC/YJK-PRINT 1080 BILL ;9/10/93 9:47 AM
V ;;4.5;Accounts Receivable;**104,112**;Mar 20, 1995
+1 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+2 SET PRCA0=$SELECT($DATA(^PRCA(430,D0,0)):^(0),1:"")
SET PRCA10=$SELECT($DATA(^(100)):^(100),1:"")
SET PRCA14=$SELECT($DATA(^(104)):^(104),1:"")
+3 SET PRCABN=D0
SET PRCA("DEBTNM")=""
SET $PIECE(PRCAUL,"_",97)=""
SET U="^"
SET CNT=0
SET PRCADFM=$SELECT($DATA(PRCADFM):PRCADFM,1:0)
if IOBS=""
SET IOBS="$C(8)"
ST WRITE @IOF
WRITE !,"Standard Form 1080 (5-70)"
if $DATA(PRCAMEND)
WRITE ?40,"AMENDED BILL"
WRITE ?75,"Voucher No. ",$SELECT($PIECE(PRCA10,U,4)]"":$PIECE(PRCA10,U,4),1:"_________"),!?3,"2 Treasury FRM 2500",?35,"VOUCHER FOR TRANSFERS"
+1 WRITE !?3,"1080-108",?27,"BETWEEN APPROPRIATIONS AND/OR FUNDS",?75,"Schedule No.________"
+2 WRITE !,"Department or Establishment, Bureau or Office Billing: ",?75,"Bill No. ",$PIECE(PRCA0,U,1)
SET Y=+$PIECE(PRCA10,U,7)
IF '$DATA(^RC(342.1,Y,1))
WRITE !!
GOTO ST1
+3 SET Y=$PIECE($GET(^RC(342.1,Y,0)),"^")_"^"_^RC(342.1,Y,1)
WRITE !?9,$PIECE(Y,U,1)
if $PIECE(Y,U,2)]""
WRITE !?9,$PIECE(Y,U,2)
+4 if $PIECE(Y,U,3)]""
WRITE !?9,$PIECE(Y,U,3)
if $PIECE(Y,U,4)]""
WRITE !?9,$PIECE(Y,U,4)
+5 WRITE !?9,$PIECE(Y,U,5),", ",$SELECT($DATA(^DIC(5,+$PIECE(Y,U,6),0)):$PIECE(^(0),U,2),1:"")," ",$PIECE(Y,U,7),!
ST1 WRITE !,"Department or Establishment, Bureau or Office Billed: ",?75,"PAID BY:"
DO DEBTOR^PRCAUTL
WRITE !?12,PRCA("DEBTNM")
IF '$DATA(PRCA("DEBTOR"))
WRITE !!!
+1 IF '$TEST
WRITE !?12,PRCAST1
if PRCAST2]""
WRITE !?12,PRCAST2
WRITE !?12,PRCACT,", ",PRCAST," ",PRCAKP,!
+2 WRITE !
DO HDR
SET PRCAI=0
SET CNT=45
DES SET PRCAI=$ORDER(^PRCA(430,PRCABN,101,PRCAI))
if 'PRCAI
GOTO ST2
SET PRCAI0=^(PRCAI,0)
SET PRCAD=0
SET DIWL=1
SET DIWR=40
SET DIWF=""
KILL ^UTILITY($JOB,"W")
+1 FOR I=0:0
SET PRCAD=$ORDER(^PRCA(430,PRCABN,101,PRCAI,1,PRCAD))
if 'PRCAD
QUIT
SET X=$SELECT($DATA(^(PRCAD,0)):^(0),1:"")
DO ^DIWP
+2 SET J=$SELECT($DATA(^UTILITY($JOB,"W",DIWL)):^(DIWL),1:0)
SET CNT=CNT-1
if CNT-6<0
DO NEWP
DO HDR
+3 SET Y=$PIECE(PRCAI0,U,1)
WRITE $PIECE(PRCAI0,U,7),?9,"|"
DO DT
SET PRCAKTM=""
+4 IF J
FOR PRCAKK=1:1:(J-1)
if PRCAKK>1
WRITE ?9,"|"
WRITE ?18,"| ",^UTILITY($JOB,"W",DIWL,PRCAKK,0),?60,"|",?68,"|",?77,"|",?83,"|",!
KILL PRCAKTM
SET CNT=CNT-1
if CNT-6<0
DO NEWP
DO HDR
+5 if '$DATA(PRCAKTM)
WRITE ?9,"|"
WRITE ?18,"|"
if $DATA(^UTILITY($JOB,"W",DIWL,J,0))
WRITE ^(0)
WRITE ?60,"|",$JUSTIFY($PIECE(PRCAI0,U,3),7,$LENGTH($PIECE($PIECE(PRCAI0,U,3),".",2)))
+6 WRITE ?68,"|",$JUSTIFY($PIECE(PRCAI0,U,4),8,$SELECT($LENGTH($PIECE($PIECE(PRCAI0,U,4),".",2))>2:4,1:2))
+7 WRITE ?77,"| ",$SELECT($DATA(^PRCD(420.5,+$PIECE(PRCAI0,U,5),0)):$PIECE(^(0),U,1),1:""),?83,"|",$JUSTIFY($PIECE(PRCAI0,U,6),12,2)
+8 KILL PRCAKTM
DO LF
SET CNT=CNT-2
GOTO DES
ST2 SET CNT=CNT-6
WRITE PRCAUL,!,"Remittance in payment hereof should be sent to: ",?75,"TOTAL, $",$JUSTIFY($PIECE(PRCA0,U,3),12,2),!
SET Y=$$SADD^RCFN01(1)
IF Y=""
WRITE !!
GOTO ST3
+1 WRITE !?8,"c/o Agent Cashier"
if $PIECE(Y,U)]""
WRITE !?9,$PIECE(Y,U)
if $PIECE(Y,U,2)]""
WRITE !?9,$PIECE(Y,U,2)
WRITE !?9,$PIECE(Y,U,3),", ",$PIECE(Y,U,4)," ",$PIECE(Y,U,5)," ",$PIECE(Y,U,6),!
ST3 SET CNT=CNT-8
if CNT<0
DO NEWP
WRITE PRCAUL,!
+1 WRITE ?30,"ACCOUNTING CLASSIFICATION - Billing Office",!,PRCAUL,!
SET I=0
FOR J=0:1
SET I=$ORDER(^PRCA(430,PRCABN,2,I))
if 'I
QUIT
IF $DATA(^(I,0))
SET Y=^(0)
if $PIECE(Y,U,4)]""
WRITE ?5,"APPROPRIATION: ",$PIECE(Y,U,4)," $ ",$JUSTIFY($PIECE(Y,U,2),12,2),!
+2 FOR J=J:1:5
WRITE !
IF J=5
IF $PIECE(PRCA14,U,2)]""
IF PRCADFM
SET DA=D0
SET P=+PRCA14
SET X=$PIECE(PRCA14,U,2)
DO DE^PRCASIG(.X,P,DA_+$PIECE(PRCA0,U,3))
if X]""
WRITE "Approving Officer: /ES/ ",X," Date: "
SET Y=$PIECE(PRCA14,U,3)
DO DT
WRITE !
+3 SET CNT=CNT-15
if CNT<0
DO NEWP
WRITE PRCAUL,!?30,"CERTIFICATE OF OFFICE BILLED",!!,?5,"I certify that the above articles were received and accepted or the services performed as",!
+4 WRITE "stated and should be charged to the appropriation(s) and/or fund(s) as indicated below; or that,",!,"the advance payments requested is approved and should be paid as indicated.",!!
+5 WRITE $EXTRACT(PRCAUL,1,30),?45,$EXTRACT(PRCAUL,1,50),!,?12,"(Date)",?46,"(Authorized administrative or certifying officer)",!!,?45,$EXTRACT(PRCAUL,1,50),!,?66,"(Title)",!,PRCAUL,!
+6 WRITE ?30,"ACCOUNTING CLASSIFICATION - Office Billed",!,PRCAUL,!!!!!,"Paid by Check No.: ",!
Q KILL CNT,D0,DA,PRCA,DIWF,DIWL,DIWR,I,J,PRCAKK,P,PRCA0,PRCA10,PRCA14,PRCABN,PRCACT,PRCAD,PRCADFM,PRCAI,PRCAI0,PRCAST,PRCAST1,PRCAST2,PRCAUL,PRCAKP,X,Y
if $DATA(ZTSK)
DO KILL^%ZTLOAD
KILL ZTSK
QUIT
DT if Y=""
QUIT
WRITE $$SLH^RCFN01(Y,"/")
QUIT
HDR WRITE !,PRCAUL,!,?9,"|",?18,"|",?60,"|",?68,"| Unit Price|",!,"ORDER NO.|",?11,"Date |",?28,"DESCRIPTION",?60,"| Qty | Cost | Per | Amount",?96
FOR I=1:1:97
WRITE @IOBS
+1 WRITE PRCAUL
SET CNT=CNT-4
LF WRITE !,?9,"|",?18,"|",?60,"|",?68,"|",?77,"|",?83,"|",!
QUIT
NEWP WRITE ?21,"CONTINUED ON NEXT PAGE",!,PRCAUL,@IOF,!!?5,"(CONTINUATION OF BILL)",?75,"Bill No. ",$PIECE(PRCA0,U,1),!!
SET CNT=60
QUIT
