source: WorldVistAEHR/trunk/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/PRCASVC6.m@ 1150

Last change on this file since 1150 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.9 KB
Line 
1PRCASVC6 ;WASH-ISC@ALTOONA,PA/RGY-CHECK OUT AR BILL ;4/8/92 12:12 PM
2V ;;4.5;Accounts Receivable;**154**;Mar 20, 1995
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 K PRCAERR
5 S PRCAERCD=$S('$D(PRCASV("ARREC")):"PRCA006",'$D(^PRCA(430,PRCASV("ARREC"),0)):"PRCA007",1:1) I 'PRCAERCD S PRCAERR="-1^"_PRCAERCD G Q
6 S PRCAERCD=$S('$P(^PRCA(430,PRCASV("ARREC"),0),U,8):"PRCA008",",201,220,"'[(","_$P(^PRCA(430.3,+$P(^(0),U,8),0),U,3)_","):"PRCA009",1:1) I 'PRCAERCD S PRCAERR="-1^"_PRCAERCD G Q
7 S PRCAERCD=$S('$D(PRCASV("BDT")):"PRCA010",PRCASV("BDT")'?7N:"PRCA011",1:1) I 'PRCAERCD S PRCAERR="-1^"_PRCAERCD G Q
8 S PRCAERCD=$S('$D(PRCASV("APR")):"PRCA012",'$D(^VA(200,PRCASV("APR"),0)):"PRCA013",1:1) I 'PRCAERCD S PRCAERR="-1^"_PRCAERCD G Q
9 D FY I 'PRCAERCD S PRCAERR="-1^"_PRCAERCD G Q
10 S PRCAERCD=$S('$D(PRCASV("CAT")):"PRCA024",'$D(^PRCA(430.2,PRCASV("CAT"),0)):"PRCA025",1:1) I 'PRCAERCD S PRCAERR="-1^"_PRCAERCD G Q
11 S PRCAT=$P(^PRCA(430.2,PRCASV("CAT"),0),"^",6) D CKDEBTR I 'PRCAERCD S PRCAERR="-1^"_PRCAERCD G Q
12 I PRCAT="C" S PRCAERCD=$S('$D(PRCASV("CARE")):"Type of care is missing",PRCASV("CARE")'?1.2N:"Type of care is not in expected format",1:1) I 'PRCAERCD S PRCAERR="-1^"_PRCAERCD G Q
13 D:PRCAT="T" THIRD
14Q S PRCASV("OKAY")=$S($G(PRCAERR)<0:0,1:1) K PRCAERCD,PRCAT Q
15THIRD ;Check out data for Third party bills
16 S DFN=+PRCASV("PAT") D DEM^VADPT
17 S PRCAERCD=$S('$D(PRCASV("PAT")):"Patient is missing",VAERR:"Patient is undefined",1:1) I 'PRCAERCD S PRCAERR="-1^"_PRCAERCD G Q4
18 I $D(PRCASV("2NDINS")),'$D(^DIC(36,+PRCASV("2NDINS"),0)) S PRCAERR="-1^2nd insurance company is undefined" G Q4
19 I $D(PRCASV("3RDINS")),'$D(^DIC(36,+PRCASV("3RDINS"),0)) S PRCAERR="-1^3rd insurance company is undefined" G Q4
20 F Y="IDNO^242","GPNO^244","GPNM^243","INPA^239" I $D(PRCASV($P(Y,"^"))) S X=PRCASV($P(Y,"^")) X $P(^DD(430,$P(Y,"^",2),0),"^",5,999) I '$D(X) S PRCAERR="-1^"_$P(^DD(430,$P(Y,"^",2),0),"^")_" is not in expected format" Q
21Q4 K VAERR
22 Q
23 ;
24CKDEBTR ;Check PRCASV("DEBTOR") variable pattern match.
25 I $S('$D(PRCASV("DEBTOR")):1,PRCASV("DEBTOR")="":1,1:0) S PRCAERCD="PRCA018" G Q1
26 I "PC"[PRCAT,PRCASV("DEBTOR")?1N.E1";DPT(" S DFN=+PRCASV("DEBTOR") D DEM^VADPT I 'VAERR G Q1
27 I PRCAT="T",PRCASV("DEBTOR")?1N.E1";DIC(36,",$D(^DIC(36,+PRCASV("DEBTOR"),0)) G Q1
28 I PRCAT="N",PRCASV("DEBTOR")?1N.E1";DIC(4,",$D(^DIC(4,+PRCASV("DEBTOR"),0)) G Q1
29 I PRCAT="V",PRCASV("DEBTOR")?1N.E1";PRC(440,",$D(^PRC(440,+PRCASV("DEBTOR"),0)) G Q1
30 I PRCAT="O",PRCASV("DEBTOR")?1N.E1";VA(200,",$D(^VA(200,+PRCASV("DEBTOR"),0)) G Q1
31 S PRCAERCD="PRCA019"
32Q1 K VAERR
33 Q
34 ;
35FY ;Check out FY variable
36 S PRCAORA=0 I '$D(PRCASV("FY")) S PRCAERCD="PRCA015" G Q2
37 F X=1:2 Q:'$P(PRCASV("FY"),"^",X) S PRCAORA=PRCAORA+$P(PRCASV("FY"),"^",X+1)
38 I $P(PRCASV("FY"),"^")="" S PRCAERCD="PRCA016" G Q2
39 I PRCAORA<0 S PRCAERCD="PRCA017" G Q2
40Q2 K PRCAORA Q
41 ;
42PRE154 ;PRE-INIT FOR PATCH PRCA*4.5*154
43 K ^PRCA(347.4,"ACR"),^("AWR")
44 Q
Note: See TracBrowser for help on using the repository browser.