| [613] | 1 | PRCAPRO ;SF-ISC/YJK-PROFILE OF ACCOUNTS RECEIVABLE ;10/17/95 2:02 PM
|
|---|
| 2 | V ;;4.5;Accounts Receivable;**2,21,125,147,198**;Mar 20, 1995
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;PRINT THE PROFILE OF A/R CALLING THE ROUTINES CREATED BY PRINT TEMPLATE
|
|---|
| 5 | INIT K %ZIS,IOP,DXS S PRCABN=""
|
|---|
| 6 | EN ;
|
|---|
| 7 | N DPTNOFZY,DPTNOFZK S (DPTNOFZY,DPTNOFZK)=1
|
|---|
| 8 | S DIC("S")="S Z0=$S($D(^PRCA(430.3,+$P(^(0),U,8),0)):$P(^(0),U,3),1:0) I (Z0<200)!(Z0=240)",DIC="^PRCA(430,",DIC(0)="AEMQZ",D="B^C^D^E" D MIX^DIC1 K DIC G:Y<0 END S (PRCABN,D0)=+Y
|
|---|
| 9 | G:$P(^PRCA(430,D0,0),U,8)="" END
|
|---|
| 10 | I $P(^PRCA(430.3,+$P(^PRCA(430,D0,0),U,8),0),U,3)=104 W *7,!,"This is a New Bill. You should audit this bill to see the profile. ",! G EN
|
|---|
| 11 | I $P(^PRCA(430.3,+$P(^PRCA(430,D0,0),U,8),0),U,3)=101 W *7,!,"This is an Incomplete Bill. You should edit this bill to see the profile.",! G EN
|
|---|
| 12 | S %ZIS="Q" D ^%ZIS Q:POP S IOM=80,PRCAIO=IO,PRCAIO(0)=IO(0)
|
|---|
| 13 | I $D(IO("Q")) K IO("Q") S ZTRTN="PROC^PRCAPRO",ZTSAVE("PRCAIO(0)")=PRCAIO(0),ZTSAVE("D0")=PRCABN,ZTSAVE("PRCABN")=PRCABN,ZTSAVE("PRCAIO")=PRCAIO,ZTDESC="Profile of Accounts Receivable" D ^%ZTLOAD,CLOSE G EN
|
|---|
| 14 | U IO D PROC,CLOSE G EN
|
|---|
| 15 | CLOSE D ^%ZISC D END Q
|
|---|
| 16 | PROC ;===============SUBROUTINE==========================================
|
|---|
| 17 | S PRCAGL=^PRCA(430,D0,0) Q:+$P(PRCAGL,U,2)'>0 S PRCAT=$P(^PRCA(430.2,$P(PRCAGL,U,2),0),U,6) S:$P(PRCAGL,U,2)=$O(^PRCA(430.2,"AC",33,0)) PRBN=D0
|
|---|
| 18 | W:IO=IO(0) @IOF
|
|---|
| 19 | K DXS,^UTILITY($J,"W") D @$S(PRCAT="C":"^PRCATP2",PRCAT="P":"^PRCATP1","OV"[PRCAT:"^PRCATP3",PRCAT="T":"^PRCATP5",1:"^PRCATP4")
|
|---|
| 20 | I +$G(PRBN),'$D(PRCA("HALT")) D DISP^PRCARFD(PRBN)
|
|---|
| 21 | W !! K PRBN,PRCAIO,ZTSAVE,ZTDTH,ZTRTN,%ZIS,IOP,DIW,DIWL,DIWR Q
|
|---|
| 22 | END K PRCAIO,PRCABN,PRCAGL,PRCAT Q
|
|---|
| 23 | TRANSPR ;TRANSACTION PROFILE
|
|---|
| 24 | EN1 N DPTNOFZY,DPTNOFZK S (DPTNOFZY,DPTNOFZK)=1
|
|---|
| 25 | K PRCAIO W ! S DIC="^PRCA(433,",DIC(0)="AEQM",DIC("A")="ENTER AR TRANSACTION NO. OR BILL NO.: " D ^DIC G:Y<0 EXIT S PRCADA=+Y
|
|---|
| 26 | S PRCA("MESS")="Do you want to queue this output " D QUE^PRCAQUE G:'$D(PRCAQUE) EXIT S IOP=PRCA("DEV"),IOM=80,PRCAIO=IO,PRCAIO(0)=IO(0)
|
|---|
| 27 | I IO=IO(0) D TR,CLOSE G EN1
|
|---|
| 28 | I PRCA("DEV")["Q" S ZTRTN="TR^PRCAPRO",ZTSAVE("PRCATYP")="",ZTSAVE("PRCADA")=PRCADA,ZTSAVE("PRCAIO(0)")=PRCAIO(0),ZTSAVE("PRCAIO")=PRCAIO,ZTDESC="Transaction Profile"
|
|---|
| 29 | I D ^%ZTLOAD,CLOSE W:(IOM-$X)<20 ! W " <REQUEST QUEUED>",*7,! D KILLV G EN1
|
|---|
| 30 | U IO D TR,CLOSE K %ZIS,IOP,PRCAIO G EN1
|
|---|
| 31 | TR W:$D(IOF)&($E(IOST,1,2)="C-") @IOF S Z="TRANSACTION PROFILE",Z1=(IOM/2)-($L(Z)/2) W !,?Z1,Z,! F I=1:1:78 W "="
|
|---|
| 32 | K Z,Z1 W ! S D0=PRCADA K DXS D ^PRCATR3 K DXS S X=PRCADA D ENF^IBOLK
|
|---|
| 33 | S PRCABN=$P($$EN^PRCAFN1(PRCADA),"^",2),CAT=+$$CAT^PRCAFN1(+PRCABN)
|
|---|
| 34 | I CAT=24 D STMT^IBRFN1(PRCADA) D:$D(^TMP("IBRFN1",$J))
|
|---|
| 35 | .S Z=0 F S Z=$O(^TMP("IBRFN1",$J,Z)) Q:'Z S X=^(Z) D
|
|---|
| 36 | ..I $P($G(^PRCA(430,+PRCABN,0)),"^",16)=4 W !,"Visit date: ",$$FMTE^XLFDT($P(X,"^",2)) Q
|
|---|
| 37 | ..W !,"Admission date: ",$$FMTE^XLFDT($P(X,"^",2)),?30,"Discharge date: ",$$FMTE^XLFDT($P(X,"^",5))
|
|---|
| 38 | D KILLV Q
|
|---|
| 39 | KILLV K DIR,DIRUT,DIROUT,DUOUT,DTOUT,PRCABN,PRCATYP,DIC,%ZIS,IOP,DA,DD,E,ZTDTH,ZTRTN,ZTSAVE,PRCA,PRCADA,PRCAQUE,DXS,^TMP("IBRFN1") Q
|
|---|
| 40 | EXIT D KILLV Q
|
|---|
