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