PRCFDS ;WISC/LEM-HANDLE FMS ACCOUNTING LINES ;6/7/94  9:39 AM
V ;;5.1;IFCAP;;Oct 20, 2000
 ;Per VHA Directive 10-93-142, this routine should not be modified.
 N DA S DA(1)=$G(PRCF("CIDA")) Q:DA(1)=""
 N NODE S NODE=$G(^PRCF(421.5,DA(1),5,0))
 I NODE="" S ^PRCF(421.5,DA(1),5,0)=U_$P(^DD(421.5,41,0),U,2)
 N CTR,I S (CTR,I)=0 F  S I=$O(PRCFD(I)) Q:I'>0  D
 . S CTR=$S(I=991:CTR,1:CTR+1),CTR=$S(CTR=991:992,1:CTR)
 . N DIC S DIC="^PRCF(421.5,"_DA(1)_",5,",DIC(0)="L"
 . S X=$P(PRCFD(I),U,1),AMT=+$P(PRCFD(I),U,2)
 . K DD,DO D FILE^DICN I Y'>0 W "ERROR" Q
 . N DIE S DIE=DIC,DA=+Y,FMSL=$S(I=991:991,1:CTR)
 . N DR S DR="1////^S X=AMT;2////^S X=FMSL" D ^DIE
 . Q
 Q
PAY W ?5,"Up to three sets of PROMPT PAYMENT TERMS may be sent to FMS with each"
 W !?5,"Payment Voucher (PV) generated by the IFCAP Payment/Invoice Tracking"
 W !?5,"module.  Enter 1, 2, or 3 to indicate which set of PROMPT PAYMENT TERMS"
 W !?5,"you wish to enter or edit.",!
 Q
 
--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCFDS   963     printed  Sep 23, 2025@19:39:18                                                                                                                                                                                                       Page 2
PRCFDS    ;WISC/LEM-HANDLE FMS ACCOUNTING LINES ;6/7/94  9:39 AM
V         ;;5.1;IFCAP;;Oct 20, 2000
 +1       ;Per VHA Directive 10-93-142, this routine should not be modified.
 +2        NEW DA
           SET DA(1)=$GET(PRCF("CIDA"))
           if DA(1)=""
               QUIT 
 +3        NEW NODE
           SET NODE=$GET(^PRCF(421.5,DA(1),5,0))
 +4        IF NODE=""
               SET ^PRCF(421.5,DA(1),5,0)=U_$PIECE(^DD(421.5,41,0),U,2)
 +5        NEW CTR,I
           SET (CTR,I)=0
           FOR 
               SET I=$ORDER(PRCFD(I))
               if I'>0
                   QUIT 
               Begin DoDot:1
 +6                SET CTR=$SELECT(I=991:CTR,1:CTR+1)
                   SET CTR=$SELECT(CTR=991:992,1:CTR)
 +7                NEW DIC
                   SET DIC="^PRCF(421.5,"_DA(1)_",5,"
                   SET DIC(0)="L"
 +8                SET X=$PIECE(PRCFD(I),U,1)
                   SET AMT=+$PIECE(PRCFD(I),U,2)
 +9                KILL DD,DO
                   DO FILE^DICN
                   IF Y'>0
                       WRITE "ERROR"
                       QUIT 
 +10               NEW DIE
                   SET DIE=DIC
                   SET DA=+Y
                   SET FMSL=$SELECT(I=991:991,1:CTR)
 +11               NEW DR
                   SET DR="1////^S X=AMT;2////^S X=FMSL"
                   DO ^DIE
 +12               QUIT 
               End DoDot:1
 +13       QUIT 
PAY        WRITE ?5,"Up to three sets of PROMPT PAYMENT TERMS may be sent to FMS with each"
 +1        WRITE !?5,"Payment Voucher (PV) generated by the IFCAP Payment/Invoice Tracking"
 +2        WRITE !?5,"module.  Enter 1, 2, or 3 to indicate which set of PROMPT PAYMENT TERMS"
 +3        WRITE !?5,"you wish to enter or edit.",!
 +4        QUIT