ABMLABRQ.m

ABMLABRQ ; IHS/SD/SDR - Require lab results by insurer ;  

 ;;2.6;IHS Third Party Billing;**3**;NOV 12, 2009

EN ;EP

 W !!?5,"An insurer and a list of CPT/HCPCS codes will be prompted for."

 W !?5,"Any codes entered for that insurer will require that a lab result be"

 W !?5,"entered.  If no result is entered, an error will display in the claim"

 W !?5,"editor.",!!

 ;

SELINS ;select insurer

 K DIC,DIE,DIR,X,Y,DA

 S DIC="^AUTNINS("

 S DIC(0)="AEQM"

 S DIC("A")="Select INSURER: "

 D ^DIC

 Q:$D(DUOUT)!$D(DTOUT)

 I +Y<0 G SELINS

 S ABMP("INS")=+Y

 ;

 ;For selected insurer, display list of CPTs (if any) entered w/status

 W !!?2,"Current Codes",?18,"Req'd?"

 S ABMCPT=0

 F  S ABMCPT=$O(^ABMNINS(DUZ(2),ABMP("INS"),4,ABMCPT)) Q:+ABMCPT=0  D

 .S ABMCNT=+$G(ABMCNT)+1

 .W !?2,$P($G(^ABMNINS(DUZ(2),ABMP("INS"),4,ABMCPT,0)),U),?18,$S($P($G(^ABMNINS(DUZ(2),ABMP("INS"),4,ABMCPT,0)),U,2)="Y":"YES",1:"NO")

 W !

 I +$G(ABMCNT)=0 W !?3,"No entries at this time"

 W !

 ;

 ;prompt for new codes

 F  D  Q:+$G(Y)<0

 .K DIC,DIE,DIR,X,Y,DA

 .S DA(1)=ABMP("INS")

 .S DIC(0)="AEQLM"

 .S DIC="^ABMNINS("_DUZ(2)_","_DA(1)_",4,"

 .S DIC("A")="Enter CPT/HCPCS codes: "

 .S DIC("P")=$P(^DD(9002274.09,4,0),U,2)

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

 .D ^DIC

 .Q:Y<0

 .S ABMIEN=Y

 .I $P(ABMIEN,U,3)'=1 D

 ..K DIC,DIE,DIR,X,Y,DA

 ..S DA(1)=ABMP("INS")

 ..S DA=+ABMIEN

 ..S DIE="^ABMNINS("_DUZ(2)_","_DA(1)_",4,"

 ..S DR=".01//;.02//"

 ..D ^DIE

 Q

ABMLABRQ  ; IHS/SD/SDR - Require lab results by insurer ;  

 +1       ;;2.6;IHS Third Party Billing;**3**;NOV 12, 2009

EN        ;EP

 +1        WRITE !!?5,"An insurer and a list of CPT/HCPCS codes will be prompted for."

 +2        WRITE !?5,"Any codes entered for that insurer will require that a lab result be"

 +3        WRITE !?5,"entered.  If no result is entered, an error will display in the claim"

 +4        WRITE !?5,"editor.",!!

 +5       ;

SELINS    ;select insurer

 +1        KILL DIC,DIE,DIR,X,Y,DA

 +2        SET DIC="^AUTNINS("

 +3        SET DIC(0)="AEQM"

 +4        SET DIC("A")="Select INSURER: "

 +5        DO ^DIC

 +6        IF $DATA(DUOUT)!$DATA(DTOUT)

               QUIT 

 +7        IF +Y<0

               GOTO SELINS

 +8        SET ABMP("INS")=+Y

 +9       ;

 +10      ;For selected insurer, display list of CPTs (if any) entered w/status

 +11       WRITE !!?2,"Current Codes",?18,"Req'd?"

 +12       SET ABMCPT=0

 +13       FOR 

               SET ABMCPT=$ORDER(^ABMNINS(DUZ(2),ABMP("INS"),4,ABMCPT))

               IF +ABMCPT=0

                   QUIT 

               Begin DoDot:1

 +14               SET ABMCNT=+$GET(ABMCNT)+1

 +15               WRITE !?2,$PIECE($GET(^ABMNINS(DUZ(2),ABMP("INS"),4,ABMCPT,0)),U),?18,$SELECT($PIECE($GET(^ABMNINS(DUZ(2),ABMP("INS"),4,ABMCPT,0)),U,2)="Y":"YES",1:"NO")

               End DoDot:1

 +16       WRITE !

 +17       IF +$GET(ABMCNT)=0

               WRITE !?3,"No entries at this time"

 +18       WRITE !

 +19      ;

 +20      ;prompt for new codes

 +21       FOR 

               Begin DoDot:1

 +22               KILL DIC,DIE,DIR,X,Y,DA

 +23               SET DA(1)=ABMP("INS")

 +24               SET DIC(0)="AEQLM"

 +25               SET DIC="^ABMNINS("_DUZ(2)_","_DA(1)_",4,"

 +26               SET DIC("A")="Enter CPT/HCPCS codes: "

 +27               SET DIC("P")=$PIECE(^DD(9002274.09,4,0),U,2)

 +28               SET DIC("DR")=".02"

 +29               DO ^DIC

 +30               IF Y<0

                       QUIT 

 +31               SET ABMIEN=Y

 +32               IF $PIECE(ABMIEN,U,3)'=1

                       Begin DoDot:2

 +33                       KILL DIC,DIE,DIR,X,Y,DA

 +34                       SET DA(1)=ABMP("INS")

 +35                       SET DA=+ABMIEN

 +36                       SET DIE="^ABMNINS("_DUZ(2)_","_DA(1)_",4,"

 +37                       SET DR=".01//;.02//"

 +38                       DO ^DIE

                       End DoDot:2

               End DoDot:1

               IF +$GET(Y)<0

                   QUIT 

 +39       QUIT