ABMRELG.m

ABMRELG ; IHS/ASDST/DMJ - FIND INS TYPE AND COVERAGE ;

 ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009

 NEW DIC,X,Y,C,DIP           ;CLEAN OUT VARIABLES

 DO ELG^ABMDLCK(D0,.ABML)

 NEW D0

 IF '$D(ABML) D  QUIT

 .I $X>19 W !

 .WRITE ?10,"NO COVERAGE"

 SET P=0,I=0,ABMNUM=0            ; SET PRIORITY, INS TO ZERO

 FOR  SET P=$ORDER(ABML(P)) QUIT:'P  D  QUIT:ABMNUM>3

 .FOR  SET I=$ORDER(ABML(P,I)) QUIT:'I  D  QUIT:ABMNUM>3

 ..SET ABMNUM=ABMNUM+1

 ..Q:ABMNUM>3

 ..SET DIC="^AUTNINS("     ; AUTNINS=INS FLMAN CALL GET VALUE OF   

 ..SET DIC(0)="N"

 ..SET X=I      ; COME BACK WITH IEN & INS COVERAGE=Y                 

 ..D ^DIC       ;   

 ..SET ABMNAME=$P(Y,U,2)     ; NAME=INS CO 

 ..SET C=0,COV=""

 ..FOR  SET C=$ORDER(ABML(P,I,"COV",C)) Q:'C  D

 ...SET COV=COV_(ABML(P,I,"COV",C))

 ..IF $X>19 W !

 ..WRITE ?10,ABMNAME," ",COV

 K ABMNUM,ABMNAME

 Q

 ;

OPT ; ENTRY POINT

 S DIR("A")="Do you want to print visits with Claims Created and Claims Modified?"

 S DIR("B")="NO"

 S DIR(0)="Y"

 D ^DIR Q:$D(DIRUT)

 I Y S ABMRSTMP="[ABMRELGS]"

 E  S ABMRSTMP="[ABMRELG RPT2]"

 S L=0

 S DIC=9000010

 S FLDS="[ABMRELG RPT]"

 S BY=ABMRSTMP

 S DIPCRIT=1

 D EN1^DIP

 Q

ABMRELG   ; IHS/ASDST/DMJ - FIND INS TYPE AND COVERAGE ;

 +1       ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009

 +2       ;CLEAN OUT VARIABLES

           NEW DIC,X,Y,C,DIP

 +3        DO ELG^ABMDLCK(D0,.ABML)

 +4        NEW D0

 +5        IF '$DATA(ABML)

               Begin DoDot:1

 +6                IF $X>19

                       WRITE !

 +7                WRITE ?10,"NO COVERAGE"

               End DoDot:1

               QUIT 

 +8       ; SET PRIORITY, INS TO ZERO

           SET P=0

           SET I=0

           SET ABMNUM=0

 +9        FOR 

               SET P=$ORDER(ABML(P))

               IF 'P

                   QUIT 

               Begin DoDot:1

 +10               FOR 

                       SET I=$ORDER(ABML(P,I))

                       IF 'I

                           QUIT 

                       Begin DoDot:2

 +11                       SET ABMNUM=ABMNUM+1

 +12                       IF ABMNUM>3

                               QUIT 

 +13      ; AUTNINS=INS FLMAN CALL GET VALUE OF   

                           SET DIC="^AUTNINS("

 +14                       SET DIC(0)="N"

 +15      ; COME BACK WITH IEN & INS COVERAGE=Y                 

                           SET X=I

 +16      ;   

                           DO ^DIC

 +17      ; NAME=INS CO 

                           SET ABMNAME=$PIECE(Y,U,2)

 +18                       SET C=0

                           SET COV=""

 +19                       FOR 

                               SET C=$ORDER(ABML(P,I,"COV",C))

                               IF 'C

                                   QUIT 

                               Begin DoDot:3

 +20                               SET COV=COV_(ABML(P,I,"COV",C))

                               End DoDot:3

 +21                       IF $X>19

                               WRITE !

 +22                       WRITE ?10,ABMNAME," ",COV

                       End DoDot:2

                       IF ABMNUM>3

                           QUIT 

               End DoDot:1

               IF ABMNUM>3

                   QUIT 

 +23       KILL ABMNUM,ABMNAME

 +24       QUIT 

 +25      ;

OPT       ; ENTRY POINT

 +1        SET DIR("A")="Do you want to print visits with Claims Created and Claims Modified?"

 +2        SET DIR("B")="NO"

 +3        SET DIR(0)="Y"

 +4        DO ^DIR

           IF $DATA(DIRUT)

               QUIT 

 +5        IF Y

               SET ABMRSTMP="[ABMRELGS]"

 +6       IF '$TEST

               SET ABMRSTMP="[ABMRELG RPT2]"

 +7        SET L=0

 +8        SET DIC=9000010

 +9        SET FLDS="[ABMRELG RPT]"

 +10       SET BY=ABMRSTMP

 +11       SET DIPCRIT=1

 +12       DO EN1^DIP

 +13       QUIT