| [613] | 1 | PRCALT2 ;WASH-ISC@ALTOONA,PA/RGY-PRINT COLLECTION LETTER UB-82 ;2/28/95 10:44 AM
|
|---|
| 2 | V ;;4.5;Accounts Receivable;**48**;Mar 20, 1995
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | NEW DEB,STAT,PRCABN,PRCA,PRCASV,EVN,ERR,DA,DIE
|
|---|
| 5 | S STAT=$O(^PRCA(430.3,"AC",102,0))
|
|---|
| 6 | F DEB=0:0 S DEB=$O(^RCD(340,"AB","DIC(36,",DEB)) Q:'DEB F PRCABN=0:0 S PRCABN=$O(^PRCA(430,"AS",DEB,STAT,PRCABN)) Q:'PRCABN D CHK
|
|---|
| 7 | Q
|
|---|
| 8 | CHK I "^21^35^37^39^"'[("^"_$P($G(^PRCA(430.2,+$P($G(^PRCA(430,PRCABN,0)),"^",2),0)),U,7)_"^") G Q
|
|---|
| 9 | I $G(^PRCA(430,PRCABN,1)) G Q
|
|---|
| 10 | S PRCA7=$G(^PRCA(430,PRCABN,7))
|
|---|
| 11 | I $P(PRCA7,U)+$P(PRCA7,U,2)+$P(PRCA7,U,3)+$P(PRCA7,U,4)+$P(PRCA7,U,5)<1 G Q
|
|---|
| 12 | I $P(^PRCA(430,PRCABN,0),U,8)'=STAT G Q
|
|---|
| 13 | L1 I "^21^35^37^39^"'[("^"_$P(^PRCA(430.2,+$P($G(^PRCA(430,PRCABN,0)),"^",2),0),"^",7)_"^") G Q
|
|---|
| 14 | I '$G(^PRCA(430,PRCABN,6)) D G Q
|
|---|
| 15 | .D OPEN^RCEVDRV1(9,$P(^RCD(340,DEB,0),"^"),DT,DUZ,$$SITE^RCMSITE(),.ERR,.EVN,$P($G(^PRCA(430,PRCABN,7)),"^",1,5)) Q:ERR]""
|
|---|
| 16 | .S $P(^PRCA(430,PRCABN,6),"^")=DT,$P(^(6),"^",9)=DT
|
|---|
| 17 | .S DIE="^RC(341,",DA=EVN,DR="5.01////^S X="_PRCABN_";5.02////^S X=1" D ^DIE
|
|---|
| 18 | .D CLOSE^RCEVDRV1(EVN,.ERR) I ERR]"" D DEL^RCEVDRV1(EVN)
|
|---|
| 19 | .Q
|
|---|
| 20 | I $P(^PRCA(430,PRCABN,6),U,4) G Q
|
|---|
| 21 | L2 I '$P(^PRCA(430,PRCABN,6),U,2) D G Q
|
|---|
| 22 | .S X1=DT,X2=$P(^PRCA(430,PRCABN,6),U,1) D ^%DTC Q:X<45
|
|---|
| 23 | .D OPEN^RCEVDRV1(9,$P(^RCD(340,DEB,0),"^"),DT,DUZ,$$SITE^RCMSITE(),.ERR,.EVN,$P($G(^PRCA(430,PRCABN,7)),"^",1,5)) Q:ERR]""
|
|---|
| 24 | .S PRCASV("ARREC")=PRCABN,PRCASV("NOTICE")=2 D REPRNT^IBCF13 Q:'IBAR("OKAY")
|
|---|
| 25 | .S $P(^PRCA(430,PRCABN,6),U,2)=DT,$P(^(6),"^",9)=DT
|
|---|
| 26 | .S DIE="^RC(341,",DA=EVN,DR="5.01////^S X="_PRCABN_";5.02////^S X=2" D ^DIE
|
|---|
| 27 | .D CLOSE^RCEVDRV1(EVN,.ERR) I ERR]"" D DEL^RCEVDRV1(EVN)
|
|---|
| 28 | .Q
|
|---|
| 29 | L3 I '$P(^PRCA(430,PRCABN,6),"^",3) D
|
|---|
| 30 | .S X1=DT,X2=$P(^PRCA(430,PRCABN,6),U,2) D ^%DTC Q:X<30
|
|---|
| 31 | .D OPEN^RCEVDRV1(9,$P(^RCD(340,DEB,0),"^"),DT,DUZ,$$SITE^RCMSITE(),.ERR,.EVN,$P($G(^PRCA(430,PRCABN,7)),"^",1,5)) Q:ERR]""
|
|---|
| 32 | .S PRCASV("ARREC")=PRCABN,PRCASV("NOTICE")=3 D REPRNT^IBCF13 Q:'IBAR("OKAY")
|
|---|
| 33 | .S $P(^PRCA(430,PRCABN,6),U,3)=DT,$P(^(6),"^",9)=DT
|
|---|
| 34 | .S DIE="^RC(341,",DA=EVN,DR="5.01////^S X="_PRCABN_";5.02////^S X=3" D ^DIE
|
|---|
| 35 | .D CLOSE^RCEVDRV1(EVN,.ERR) I ERR]"" D DEL^RCEVDRV1(EVN)
|
|---|
| 36 | .Q
|
|---|
| 37 | Q Q
|
|---|
