source: FOIAVistA/trunk/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/PRCASVC3.m@ 1765

Last change on this file since 1765 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 1.4 KB
Line 
1PRCASVC3 ;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 ;
8SETUP ;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 ;
12RTRY 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
Note: See TracBrowser for help on using the repository browser.