BARDRPYR.m

BARDRPYR ; IHS/SD/LSL - DCM RESTRICT PAYERS ; 

 ;;1.8;IHS ACCOUNTS RECEIVABLE;;OCT 26, 2005

 ;

 ; IHS/SD/LSL - 04/06/04 - V1.8

 ;      Routine created.  Modified version of BBMDC3 to move to

 ;      AR namespace and use AR Site Parameters fields.

 ;

 ; ********************************************************************

 ;

EP ; EP

 D:'$D(BARUSR) INIT^BARUTL           ; Set up basic A/R Variables

 K DIC,DR,DA,DIE,BARMULT

 W !!

 S DIC="^BAR(90052.06,DUZ(2),"

 S DIC(0)="AEMQZ"

 K DD,DO

 D ^DIC

 Q:+Y<1

 W !!

 S BARSITE=+Y

 K DIC,DR,DA,DIE

 S DA(1)=BARSITE

 S DIC="^BAR(90052.06,DUZ(2),"_DA(1)_",13,"

 S DIC("A")="Select A/R Account to Restrict Transmission: "

 S DIC(0)="AEMQLZ"

 S DIC("P")=$P(^DD(90052.06,1300,0),U,2)

 S DIC("DR")=".02////1"

 S DLAYGO=90052

 K Y

 S BARDONE=0

 F  D  Q:+BARDONE

 . I $D(BARMULT) S DIC("A")="Select Another A/R Account to Restrict Transmission: "

 . K DD,DO

 . D ^DIC

 . I +Y<1 S BARDONE=1 Q

 . S BARMULT=1

 . S DA=+Y

 . S DIE=DIC

 . S DR=".01;.02"

 . D ^DIE

 . W !

 Q

BARDRPYR  ; IHS/SD/LSL - DCM RESTRICT PAYERS ; 

 +1       ;;1.8;IHS ACCOUNTS RECEIVABLE;;OCT 26, 2005

 +2       ;

 +3       ; IHS/SD/LSL - 04/06/04 - V1.8

 +4       ;      Routine created.  Modified version of BBMDC3 to move to

 +5       ;      AR namespace and use AR Site Parameters fields.

 +6       ;

 +7       ; ********************************************************************

 +8       ;

EP        ; EP

 +1       ; Set up basic A/R Variables

           IF '$DATA(BARUSR)

               DO INIT^BARUTL

 +2        KILL DIC,DR,DA,DIE,BARMULT

 +3        WRITE !!

 +4        SET DIC="^BAR(90052.06,DUZ(2),"

 +5        SET DIC(0)="AEMQZ"

 +6        KILL DD,DO

 +7        DO ^DIC

 +8        IF +Y<1

               QUIT 

 +9        WRITE !!

 +10       SET BARSITE=+Y

 +11       KILL DIC,DR,DA,DIE

 +12       SET DA(1)=BARSITE

 +13       SET DIC="^BAR(90052.06,DUZ(2),"_DA(1)_",13,"

 +14       SET DIC("A")="Select A/R Account to Restrict Transmission: "

 +15       SET DIC(0)="AEMQLZ"

 +16       SET DIC("P")=$PIECE(^DD(90052.06,1300,0),U,2)

 +17       SET DIC("DR")=".02////1"

 +18       SET DLAYGO=90052

 +19       KILL Y

 +20       SET BARDONE=0

 +21       FOR 

               Begin DoDot:1

 +22               IF $DATA(BARMULT)

                       SET DIC("A")="Select Another A/R Account to Restrict Transmission: "

 +23               KILL DD,DO

 +24               DO ^DIC

 +25               IF +Y<1

                       SET BARDONE=1

                       QUIT 

 +26               SET BARMULT=1

 +27               SET DA=+Y

 +28               SET DIE=DIC

 +29               SET DR=".01;.02"

 +30               DO ^DIE

 +31               WRITE !

               End DoDot:1

               IF +BARDONE

                   QUIT 

 +32       QUIT