PRYBPOST.m

PRYBPOST ;Washington ISC@Altoona,Pa/TJK-SETS FILE 433 "AW" X-REF ;4/18/95  8:06 AM

V ;;4.5;Accounts Receivable;**3**;Mar 20, 1995

 N RCI,TRTYP

 W !,"SETTING AW X-REF IN FILE 433"

 ;S DIK="^PRCA(433,",DIK(1)="12^AW" D ENALL^DIK

 S RCI=0 F  S RCI=$O(^PRCA(433,RCI)) Q:RCI'?1N.N  D

    .S TRTYP=$P($G(^PRCA(433,RCI,1)),U,2)

    .I TRTYP>7,TRTYP<12 S ^PRCA(433,"AW",TRTYP,RCI)="" W "."

    .Q

 W !,"AW X-REF SET"

 W !,"RECOMPILING PRCA BATCH PAYMENT INPUT TEMPLATE"

 S X="PRCATB",Y=$O(^DIE("B","PRCA BATCH PAYMENT",0)),DMAX=5000

 D EN^DIEZ

 W !,"PRCA BATCH PAYMENT INPUT TEMPLATE RECOMPILED",!,"DONE"

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---PRYBPOST   615     printed  Apr 09, 2024@20:52:05                                                                                                                                                                                                     Page 2

PRYBPOST  ;Washington ISC@Altoona,Pa/TJK-SETS FILE 433 "AW" X-REF ;4/18/95  8:06 AM

V         ;;4.5;Accounts Receivable;**3**;Mar 20, 1995

 +1        NEW RCI,TRTYP

 +2        WRITE !,"SETTING AW X-REF IN FILE 433"

 +3       ;S DIK="^PRCA(433,",DIK(1)="12^AW" D ENALL^DIK

 +4        SET RCI=0

           FOR 

               SET RCI=$ORDER(^PRCA(433,RCI))

               if RCI'?1N.N

                   QUIT 

               Begin DoDot:1

 +5                SET TRTYP=$PIECE($GET(^PRCA(433,RCI,1)),U,2)

 +6                IF TRTYP>7

                       IF TRTYP<12

                           SET ^PRCA(433,"AW",TRTYP,RCI)=""

                           WRITE "."

 +7                QUIT 

               End DoDot:1

 +8        WRITE !,"AW X-REF SET"

 +9        WRITE !,"RECOMPILING PRCA BATCH PAYMENT INPUT TEMPLATE"

 +10       SET X="PRCATB"

           SET Y=$ORDER(^DIE("B","PRCA BATCH PAYMENT",0))

           SET DMAX=5000

 +11       DO EN^DIEZ

 +12       WRITE !,"PRCA BATCH PAYMENT INPUT TEMPLATE RECOMPILED",!,"DONE"

 +13       QUIT