BARRSL3.m

BARRSL3 ; IHS/SD/LSL - PICK A X-REF ;

 ;;1.8;IHS ACCOUNTS RECEIVABLE;**19,20**;OCT 26, 2005

 ;

 ;;1.8*19 7/11/10 ADD ADJ TYPE INQUIRY

 ;

START ;START

 K BARXVL2

 I $G(BARY("DT"))="A" D  Q

 .S BARXRF="AP"

 .S BARXVL1=BARY("DT",1)

 .S BARXVL2=BARY("DT",2)

 I $G(BARY("DT"))="V" D  Q

 .S BARXRF="AD"

 .S BARXVL1=BARY("DT",1)

 .S BARXVL2=BARY("DT",2)

 I $G(BARY("DT"))="X" D  Q

 .S BARXRF="AX"

 .S BARXVL1=$O(^ABMDTXST(DUZ(2),"B",(BARY("DT",1)-.1),0))

 .S BARXVL2=$O(^ABMDTXST(DUZ(2),"B",(BARY("DT",2)+.1),0))

 I $G(BARY("INS")) D  Q

 .S BARXRF="AJ"

 .S BARXVL1=BARY("INS")

 I $G(BARY("PAT")) D  Q

 .S BARXRF="D"

 .S BARXVL1=BARY("PAT")

 S BARXRF="B"

 S BARXVL1=0

 Q

ADJTYPE  ; EP  IHS/SD/PKD 1.8*20 from BARTRANS

 ; Select ADJ TYPES to SELECT 

 K BARY("ADJ TYP")

 K DIC,DIE,DR,DA,DIR

 S DIC=90052.02

 S DIC(0)="AEMQ"

 S DIC("S")="I "",3,4,13,14,15,16,19,20,21,22,25,""[("",""_$P(^(0),U,2)_"","")"

 W !

 S DIC("A")="You may select ADJUSTMENT TYPE: ALL// "

 F  D  Q:+Y<0

 . I $D(BARY("ADJ TYP")) S DIC("A")="   Select Another ADJUSTMENT TYPE: "

 . D ^DIC

 . Q:+Y<0

 . S BARY("ADJ TYP",+Y)=$P(Y,U,2)

 I '$D(BARY("ADJ TYP")) D

 . I $D(DUOUT) K BARY("SORT") Q

 . W "ALL"

 K DIC

 Q

 ;IHS/SD/SDR Below commented out in patch20 since it wasn't in Paula's routine

 ;leaving code just in case

 ;IHS/SD/AR 1.8*19 07/11/2010 ADJ TYPE INQ

 ;ASKATYPE ;GET ADJUSTMENT TYPES

 ;K DIC

 ;S DIC=90052.02

 ;S DIC(0)="AEZ"

 ;S DIC("A")="Enter ADJUSTMENT TYPE (Reason): "

 ;S DIC("S")="I "",3,4,13,14,15,16,19,20,21,22,25,""[("",""_$P(^(0),U,2)_"","")"

 ;S DIC("W")="I "",3,4,13,14,15,16,19,20,21,22,25,""[("",""_$P(^(0),U,2)_"","")"

 ;D ^DIC

 ;K DIC

 ;W:(Y<1)&'$D(DUOUT)&'$D(BARATYP) "ALL"

 ;Q:$D(DTOUT)!$D(DUOUT)!(Y<1)

 ;S BARATYP($P(Y,U,2))=$P(Y,U,1)_U_Y(0)

 ;G ASKATYPE

BARRSL3   ; IHS/SD/LSL - PICK A X-REF ;

 +1       ;;1.8;IHS ACCOUNTS RECEIVABLE;**19,20**;OCT 26, 2005

 +2       ;

 +3       ;;1.8*19 7/11/10 ADD ADJ TYPE INQUIRY

 +4       ;

START     ;START

 +1        KILL BARXVL2

 +2        IF $GET(BARY("DT"))="A"

               Begin DoDot:1

 +3                SET BARXRF="AP"

 +4                SET BARXVL1=BARY("DT",1)

 +5                SET BARXVL2=BARY("DT",2)

               End DoDot:1

               QUIT 

 +6        IF $GET(BARY("DT"))="V"

               Begin DoDot:1

 +7                SET BARXRF="AD"

 +8                SET BARXVL1=BARY("DT",1)

 +9                SET BARXVL2=BARY("DT",2)

               End DoDot:1

               QUIT 

 +10       IF $GET(BARY("DT"))="X"

               Begin DoDot:1

 +11               SET BARXRF="AX"

 +12               SET BARXVL1=$ORDER(^ABMDTXST(DUZ(2),"B",(BARY("DT",1)-.1),0))

 +13               SET BARXVL2=$ORDER(^ABMDTXST(DUZ(2),"B",(BARY("DT",2)+.1),0))

               End DoDot:1

               QUIT 

 +14       IF $GET(BARY("INS"))

               Begin DoDot:1

 +15               SET BARXRF="AJ"

 +16               SET BARXVL1=BARY("INS")

               End DoDot:1

               QUIT 

 +17       IF $GET(BARY("PAT"))

               Begin DoDot:1

 +18               SET BARXRF="D"

 +19               SET BARXVL1=BARY("PAT")

               End DoDot:1

               QUIT 

 +20       SET BARXRF="B"

 +21       SET BARXVL1=0

 +22       QUIT 

ADJTYPE   ; EP  IHS/SD/PKD 1.8*20 from BARTRANS

 +1       ; Select ADJ TYPES to SELECT 

 +2        KILL BARY("ADJ TYP")

 +3        KILL DIC,DIE,DR,DA,DIR

 +4        SET DIC=90052.02

 +5        SET DIC(0)="AEMQ"

 +6        SET DIC("S")="I "",3,4,13,14,15,16,19,20,21,22,25,""[("",""_$P(^(0),U,2)_"","")"

 +7        WRITE !

 +8        SET DIC("A")="You may select ADJUSTMENT TYPE: ALL// "

 +9        FOR 

               Begin DoDot:1

 +10               IF $DATA(BARY("ADJ TYP"))

                       SET DIC("A")="   Select Another ADJUSTMENT TYPE: "

 +11               DO ^DIC

 +12               IF +Y<0

                       QUIT 

 +13               SET BARY("ADJ TYP",+Y)=$PIECE(Y,U,2)

               End DoDot:1

               IF +Y<0

                   QUIT 

 +14       IF '$DATA(BARY("ADJ TYP"))

               Begin DoDot:1

 +15               IF $DATA(DUOUT)

                       KILL BARY("SORT")

                       QUIT 

 +16               WRITE "ALL"

               End DoDot:1

 +17       KILL DIC

 +18       QUIT 

 +19      ;IHS/SD/SDR Below commented out in patch20 since it wasn't in Paula's routine

 +20      ;leaving code just in case

 +21      ;IHS/SD/AR 1.8*19 07/11/2010 ADJ TYPE INQ

 +22      ;ASKATYPE ;GET ADJUSTMENT TYPES

 +23      ;K DIC

 +24      ;S DIC=90052.02

 +25      ;S DIC(0)="AEZ"

 +26      ;S DIC("A")="Enter ADJUSTMENT TYPE (Reason): "

 +27      ;S DIC("S")="I "",3,4,13,14,15,16,19,20,21,22,25,""[("",""_$P(^(0),U,2)_"","")"

 +28      ;S DIC("W")="I "",3,4,13,14,15,16,19,20,21,22,25,""[("",""_$P(^(0),U,2)_"","")"

 +29      ;D ^DIC

 +30      ;K DIC

 +31      ;W:(Y<1)&'$D(DUOUT)&'$D(BARATYP) "ALL"

 +32      ;Q:$D(DTOUT)!$D(DUOUT)!(Y<1)

 +33      ;S BARATYP($P(Y,U,2))=$P(Y,U,1)_U_Y(0)

 +34      ;G ASKATYPE