- PRCAFOR ;WASH-ISC@ALTOONA,PA/RGY-VIA A FORM FROM BILLING MODULE ;6/22/93 2:20 PM
- V ;;4.5;Accounts Receivable;**198**;Mar 20, 1995
- ;;Per VHA Directive 10-93-142, this routine should not be modified.
- NEW DIC,Y,PRCAP,L,FR,TO,BY,FLDS
- N DPTNOFZY,DPTNOFZK S (DPTNOFZY,DPTNOFZK)=1
- D SVC^PRCABIL G:'$D(PRCAP("S")) Q
- BEG F S DIC="^PRCA(430,",DIC(0)="QEAM",DIC("S")="I +$G(^(100)),$P($G(^(100)),""^"",2)=PRCAP(""S"")" D ^DIC G:Y<0 Q S L=0,FLDS="[PRCA VENDOR PROFILE]",(FR,TO)=+Y,BY="@NUMBER" D EN1^DIP
- Q Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCAFOR 510 printed Feb 18, 2025@23:05:57 Page 2
- PRCAFOR ;WASH-ISC@ALTOONA,PA/RGY-VIA A FORM FROM BILLING MODULE ;6/22/93 2:20 PM
- V ;;4.5;Accounts Receivable;**198**;Mar 20, 1995
- +1 ;;Per VHA Directive 10-93-142, this routine should not be modified.
- +2 NEW DIC,Y,PRCAP,L,FR,TO,BY,FLDS
- +3 NEW DPTNOFZY,DPTNOFZK
- SET (DPTNOFZY,DPTNOFZK)=1
- +4 DO SVC^PRCABIL
- if '$DATA(PRCAP("S"))
- GOTO Q
- BEG FOR
- SET DIC="^PRCA(430,"
- SET DIC(0)="QEAM"
- SET DIC("S")="I +$G(^(100)),$P($G(^(100)),""^"",2)=PRCAP(""S"")"
- DO ^DIC
- if Y<0
- GOTO Q
- SET L=0
- SET FLDS="[PRCA VENDOR PROFILE]"
- SET (FR,TO)=+Y
- SET BY="@NUMBER"
- DO EN1^DIP
- Q QUIT