- 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 Feb 18, 2025@23:07:48 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
