PRCFDS.m

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 ---PRCFDS   963     printed  Apr 09, 2024@21:08:35                                                                                                                                                                                                       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