PRCASVC6 ;WASH-ISC@ALTOONA,PA/RGY-CHECK OUT AR BILL ;4/8/92 12:12 PM
V ;;4.5;Accounts Receivable;**154**;Mar 20, 1995
;;Per VHA Directive 10-93-142, this routine should not be modified.
K PRCAERR
S PRCAERCD=$S('$D(PRCASV("ARREC")):"PRCA006",'$D(^PRCA(430,PRCASV("ARREC"),0)):"PRCA007",1:1) I 'PRCAERCD S PRCAERR="-1^"_PRCAERCD G Q
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
S PRCAERCD=$S('$D(PRCASV("BDT")):"PRCA010",PRCASV("BDT")'?7N:"PRCA011",1:1) I 'PRCAERCD S PRCAERR="-1^"_PRCAERCD G Q
S PRCAERCD=$S('$D(PRCASV("APR")):"PRCA012",'$D(^VA(200,PRCASV("APR"),0)):"PRCA013",1:1) I 'PRCAERCD S PRCAERR="-1^"_PRCAERCD G Q
D FY I 'PRCAERCD S PRCAERR="-1^"_PRCAERCD G Q
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
S PRCAT=$P(^PRCA(430.2,PRCASV("CAT"),0),"^",6) D CKDEBTR I 'PRCAERCD S PRCAERR="-1^"_PRCAERCD G Q
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
D:PRCAT="T" THIRD
Q S PRCASV("OKAY")=$S($G(PRCAERR)<0:0,1:1) K PRCAERCD,PRCAT Q
THIRD ;Check out data for Third party bills
S DFN=+PRCASV("PAT") D DEM^VADPT
S PRCAERCD=$S('$D(PRCASV("PAT")):"Patient is missing",VAERR:"Patient is undefined",1:1) I 'PRCAERCD S PRCAERR="-1^"_PRCAERCD G Q4
I $D(PRCASV("2NDINS")),'$D(^DIC(36,+PRCASV("2NDINS"),0)) S PRCAERR="-1^2nd insurance company is undefined" G Q4
I $D(PRCASV("3RDINS")),'$D(^DIC(36,+PRCASV("3RDINS"),0)) S PRCAERR="-1^3rd insurance company is undefined" G Q4
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
Q4 K VAERR
Q
;
CKDEBTR ;Check PRCASV("DEBTOR") variable pattern match.
I $S('$D(PRCASV("DEBTOR")):1,PRCASV("DEBTOR")="":1,1:0) S PRCAERCD="PRCA018" G Q1
I "PC"[PRCAT,PRCASV("DEBTOR")?1N.E1";DPT(" S DFN=+PRCASV("DEBTOR") D DEM^VADPT I 'VAERR G Q1
I PRCAT="T",PRCASV("DEBTOR")?1N.E1";DIC(36,",$D(^DIC(36,+PRCASV("DEBTOR"),0)) G Q1
I PRCAT="N",PRCASV("DEBTOR")?1N.E1";DIC(4,",$D(^DIC(4,+PRCASV("DEBTOR"),0)) G Q1
I PRCAT="V",PRCASV("DEBTOR")?1N.E1";PRC(440,",$D(^PRC(440,+PRCASV("DEBTOR"),0)) G Q1
I PRCAT="O",PRCASV("DEBTOR")?1N.E1";VA(200,",$D(^VA(200,+PRCASV("DEBTOR"),0)) G Q1
S PRCAERCD="PRCA019"
Q1 K VAERR
Q
;
FY ;Check out FY variable
S PRCAORA=0 I '$D(PRCASV("FY")) S PRCAERCD="PRCA015" G Q2
F X=1:2 Q:'$P(PRCASV("FY"),"^",X) S PRCAORA=PRCAORA+$P(PRCASV("FY"),"^",X+1)
I $P(PRCASV("FY"),"^")="" S PRCAERCD="PRCA016" G Q2
I PRCAORA<0 S PRCAERCD="PRCA017" G Q2
Q2 K PRCAORA Q
;
PRE154 ;PRE-INIT FOR PATCH PRCA*4.5*154
K ^PRCA(347.4,"ACR"),^("AWR")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCASVC6 2977 printed Apr 09, 2024@20:44:12 Page 2
PRCASVC6 ;WASH-ISC@ALTOONA,PA/RGY-CHECK OUT AR BILL ;4/8/92 12:12 PM
V ;;4.5;Accounts Receivable;**154**;Mar 20, 1995
+1 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+2 KILL PRCAERR
+3 SET PRCAERCD=$SELECT('$DATA(PRCASV("ARREC")):"PRCA006",'$DATA(^PRCA(430,PRCASV("ARREC"),0)):"PRCA007",1:1)
IF 'PRCAERCD
SET PRCAERR="-1^"_PRCAERCD
GOTO Q
+4 SET PRCAERCD=$SELECT('$PIECE(^PRCA(430,PRCASV("ARREC"),0),U,8):"PRCA008",",201,220,"'[(","_$PIECE(^PRCA(430.3,+$PIECE(^(0),U,8),0),U,3)_","):"PRCA009",1:1)
IF 'PRCAERCD
SET PRCAERR="-1^"_PRCAERCD
GOTO Q
+5 SET PRCAERCD=$SELECT('$DATA(PRCASV("BDT")):"PRCA010",PRCASV("BDT")'?7N:"PRCA011",1:1)
IF 'PRCAERCD
SET PRCAERR="-1^"_PRCAERCD
GOTO Q
+6 SET PRCAERCD=$SELECT('$DATA(PRCASV("APR")):"PRCA012",'$DATA(^VA(200,PRCASV("APR"),0)):"PRCA013",1:1)
IF 'PRCAERCD
SET PRCAERR="-1^"_PRCAERCD
GOTO Q
+7 DO FY
IF 'PRCAERCD
SET PRCAERR="-1^"_PRCAERCD
GOTO Q
+8 SET PRCAERCD=$SELECT('$DATA(PRCASV("CAT")):"PRCA024",'$DATA(^PRCA(430.2,PRCASV("CAT"),0)):"PRCA025",1:1)
IF 'PRCAERCD
SET PRCAERR="-1^"_PRCAERCD
GOTO Q
+9 SET PRCAT=$PIECE(^PRCA(430.2,PRCASV("CAT"),0),"^",6)
DO CKDEBTR
IF 'PRCAERCD
SET PRCAERR="-1^"_PRCAERCD
GOTO Q
+10 IF PRCAT="C"
SET PRCAERCD=$SELECT('$DATA(PRCASV("CARE")):"Type of care is missing",PRCASV("CARE")'?1.2N:"Type of care is not in expected format",1:1)
IF 'PRCAERCD
SET PRCAERR="-1^"_PRCAERCD
GOTO Q
+11 if PRCAT="T"
DO THIRD
Q SET PRCASV("OKAY")=$SELECT($GET(PRCAERR)<0:0,1:1)
KILL PRCAERCD,PRCAT
QUIT
THIRD ;Check out data for Third party bills
+1 SET DFN=+PRCASV("PAT")
DO DEM^VADPT
+2 SET PRCAERCD=$SELECT('$DATA(PRCASV("PAT")):"Patient is missing",VAERR:"Patient is undefined",1:1)
IF 'PRCAERCD
SET PRCAERR="-1^"_PRCAERCD
GOTO Q4
+3 IF $DATA(PRCASV("2NDINS"))
IF '$DATA(^DIC(36,+PRCASV("2NDINS"),0))
SET PRCAERR="-1^2nd insurance company is undefined"
GOTO Q4
+4 IF $DATA(PRCASV("3RDINS"))
IF '$DATA(^DIC(36,+PRCASV("3RDINS"),0))
SET PRCAERR="-1^3rd insurance company is undefined"
GOTO Q4
+5 FOR Y="IDNO^242","GPNO^244","GPNM^243","INPA^239"
IF $DATA(PRCASV($PIECE(Y,"^")))
SET X=PRCASV($PIECE(Y,"^"))
XECUTE $PIECE(^DD(430,$PIECE(Y,"^",2),0),"^",5,999)
IF '$DATA(X)
SET PRCAERR="-1^"_$PIECE(^DD(430,$PIECE(Y,"^",2),0),"^")_" is not in expected format"
QUIT
Q4 KILL VAERR
+1 QUIT
+2 ;
CKDEBTR ;Check PRCASV("DEBTOR") variable pattern match.
+1 IF $SELECT('$DATA(PRCASV("DEBTOR")):1,PRCASV("DEBTOR")="":1,1:0)
SET PRCAERCD="PRCA018"
GOTO Q1
+2 IF "PC"[PRCAT
IF PRCASV("DEBTOR")?1N.E1";DPT("
SET DFN=+PRCASV("DEBTOR")
DO DEM^VADPT
IF 'VAERR
GOTO Q1
+3 IF PRCAT="T"
IF PRCASV("DEBTOR")?1N.E1";DIC(36,"
IF $DATA(^DIC(36,+PRCASV("DEBTOR"),0))
GOTO Q1
+4 IF PRCAT="N"
IF PRCASV("DEBTOR")?1N.E1";DIC(4,"
IF $DATA(^DIC(4,+PRCASV("DEBTOR"),0))
GOTO Q1
+5 IF PRCAT="V"
IF PRCASV("DEBTOR")?1N.E1";PRC(440,"
IF $DATA(^PRC(440,+PRCASV("DEBTOR"),0))
GOTO Q1
+6 IF PRCAT="O"
IF PRCASV("DEBTOR")?1N.E1";VA(200,"
IF $DATA(^VA(200,+PRCASV("DEBTOR"),0))
GOTO Q1
+7 SET PRCAERCD="PRCA019"
Q1 KILL VAERR
+1 QUIT
+2 ;
FY ;Check out FY variable
+1 SET PRCAORA=0
IF '$DATA(PRCASV("FY"))
SET PRCAERCD="PRCA015"
GOTO Q2
+2 FOR X=1:2
if '$PIECE(PRCASV("FY"),"^",X)
QUIT
SET PRCAORA=PRCAORA+$PIECE(PRCASV("FY"),"^",X+1)
+3 IF $PIECE(PRCASV("FY"),"^")=""
SET PRCAERCD="PRCA016"
GOTO Q2
+4 IF PRCAORA<0
SET PRCAERCD="PRCA017"
GOTO Q2
Q2 KILL PRCAORA
QUIT
+1 ;
PRE154 ;PRE-INIT FOR PATCH PRCA*4.5*154
+1 KILL ^PRCA(347.4,"ACR"),^("AWR")
+2 QUIT
