PRCAFOR.m

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 ---PRCAFOR   510     printed  Apr 09, 2024@20:52:54                                                                                                                                                                                                      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