ADEATT2.m

ADEATT2 ; IHS/HQT/MJL  - ATTENDING DDS STMNT PT 2 ;  [ 03/24/1999   9:04 AM ]

 ;;6.0;ADE;**26**;APRIL 1999;Build 13

 ;;IHS/OIT/GAB 10.2014 Modified for 2015 Code Updates - PATCH 26

READ D LIST^ADEGRL3 W !,"INSURER: ",ADEINSN

 W !,"Select ADA CODE: " R X:DTIME

 I '$T!(X="^") S Y=0 W !?5,"***ABORTED***" Q

 I X="" S Y=1 Q

 I X="?" W !?5,"Select an ADA CODE from the above list,",!?5,"or enter `^C' to edit the TOTAL CHARGE" H 1.7 G READ

 I X="^C" D TFEE^ADEGRL31 G READ

 I '$D(ADEV(X)) W " ??",*7 G READ

 ;IHS/OIT/GAB 11.2014 Modified below line and added the next for 2015 Code updates - PATCH #26

 ;I X="0190"!(X="0000")!(X="9130")!(X="9140") W *7," -- FEE NOT ALLOWED" H 1 G READ

 I X="0190"!(X="0000")!(X="9130")!(X="9140")!(X="9986")!(X="9987") W *7," -- FEE NOT ALLOWED" H 1 G READ

 S ADECOD=X

 D FEE^ADEGRL31

 G READ

 Q

FEE ;EP

 ;------->LOOP THRU ADEV AND GET FEE FROM ^ADEFEE

 S X=0 F J=0:0 S X=$O(ADEV(X)) Q:X=""  I $D(^AUTTADA("B",X)) S Y=$O(^AUTTADA("B",X,0)) D:Y F1

 Q

F1 I $D(^ADEFEE(Y,0)) S $P(ADEV(X),U,3)=$P(^ADEFEE(Y,0),U,2)

 Q

ADEATT2   ; IHS/HQT/MJL  - ATTENDING DDS STMNT PT 2 ;  [ 03/24/1999   9:04 AM ]

 +1       ;;6.0;ADE;**26**;APRIL 1999;Build 13

 +2       ;;IHS/OIT/GAB 10.2014 Modified for 2015 Code Updates - PATCH 26

READ       DO LIST^ADEGRL3

           WRITE !,"INSURER: ",ADEINSN

 +1        WRITE !,"Select ADA CODE: "

           READ X:DTIME

 +2        IF '$TEST!(X="^")

               SET Y=0

               WRITE !?5,"***ABORTED***"

               QUIT 

 +3        IF X=""

               SET Y=1

               QUIT 

 +4        IF X="?"

               WRITE !?5,"Select an ADA CODE from the above list,",!?5,"or enter `^C' to edit the TOTAL CHARGE"

               HANG 1.7

               GOTO READ

 +5        IF X="^C"

               DO TFEE^ADEGRL31

               GOTO READ

 +6        IF '$DATA(ADEV(X))

               WRITE " ??",*7

               GOTO READ

 +7       ;IHS/OIT/GAB 11.2014 Modified below line and added the next for 2015 Code updates - PATCH #26

 +8       ;I X="0190"!(X="0000")!(X="9130")!(X="9140") W *7," -- FEE NOT ALLOWED" H 1 G READ

 +9        IF X="0190"!(X="0000")!(X="9130")!(X="9140")!(X="9986")!(X="9987")

               WRITE *7," -- FEE NOT ALLOWED"

               HANG 1

               GOTO READ

 +10       SET ADECOD=X

 +11       DO FEE^ADEGRL31

 +12       GOTO READ

 +13       QUIT 

FEE       ;EP

 +1       ;------->LOOP THRU ADEV AND GET FEE FROM ^ADEFEE

 +2        SET X=0

           FOR J=0:0

               SET X=$ORDER(ADEV(X))

               IF X=""

                   QUIT 

               IF $DATA(^AUTTADA("B",X))

                   SET Y=$ORDER(^AUTTADA("B",X,0))

                   IF Y

                       DO F1

 +3        QUIT 

F1         IF $DATA(^ADEFEE(Y,0))

               SET $PIECE(ADEV(X),U,3)=$PIECE(^ADEFEE(Y,0),U,2)

 +1        QUIT