PRCASVC3 ;WASH-ISC@ALTOONA,PA/RGY-SERVICE BILL CREATOR ;4/27/94  10:09 AM
 ;;4.5;Accounts Receivable;**158,202**;Mar 20, 1995
 ;;Per VHA Directive 10-93-142, this routine should not be modified.
 ;INPUT     PRCASV("SITE")=IFCAP site, PRCASV("SER")=Service/Section
 ;OUTPUT    PRCASV("ARREC")=Internal rec. # <OR> -1^Error message
 ;          PRCASV("ARBIL")=Bill # <OR> -1^Error message
 ;
SETUP ;RETURN THE INTERNAL RECORD NUMBER OF FILE 430
 N %,%X,%Y,D,D0,DA,DD,DI,DIC,DICR,DIE,DIG,DIH,DINUM,DIU,DIV,DIW,DLAYGO
 N DO,DQ,DR,PRCAP,RCDA,X,Y
 ;
RTRY S (PRCASV("ARBIL"),PRCASV("ARREC"))=-1
 I $S('$D(PRCASV("SITE"))#2:1,'PRCASV("SITE"):1,1:0) D  Q
 . S PRCASV("ARBIL")="-1^PRCA001"
 S DINUM=$S($D(^PRCA(430,0)):$P(^PRCA(430,0),"^",3),1:-1)+1
 I 'DINUM S PRCASV("ARREC")="-1^PRCA005" Q
 F DINUM=DINUM:1 I '$D(^PRCA(430,DINUM)),'$D(^DGCR(399,DINUM)) L +^PRCA(430,DINUM):1 Q:$T
 S RCDA=DINUM,DIC="^PRCA(430,",DIC(0)="QL",DLAYGO=430
 S (PRCASV("ARBIL"),X)=$$BNUM^RCMSNUM(PRCASV("SITE"))
 I $P(X,"^")=-1 L -^PRCA(430,RCDA) Q
 K DD,DO D FILE^DICN
 I Y<0 L -^PRCA(430,RCDA) G RTRY
 S (PRCASV("ARREC"),DA)=+Y,$P(^PRCA(430,DA,0),U,12)=PRCASV("SITE")
 S $P(^PRCA(430,DA,100),U,2)=PRCASV("SER")
 I $G(DUZ)!$G(RCDUZ) S $P(^PRCA(430,DA,9),U,8)=$S($G(RCDUZ):RCDUZ,1:DUZ)
 S PRCASV("STATUS")=$O(^PRCA(430.3,"AC",201,""))
 S DIE="^PRCA(430,",DR="[PRCASV STATUS]" D ^DIE
 K PRCASV("STATUS")
 L -^PRCA(430,RCDA)
 Q