ABMM2PV8.m

ABMM2PV8 ;IHS/SD/SDR - MU Patient Volume EP Report ;

 ;;2.6;IHS 3P BILLING SYSTEM;**12,15**;NOV 12, 2009;Build 251

 ;IHS/SD/SDR - 2.6*15 - HEAT161159 - Made change to correct duplicates; also made changes to resolve summary not reconciling to pt list

 ;IHS/SD/SDR - 2.6*15 - HEAT183289 - Added code for Tribal self-insured; will look if patient has only one insurer and that insurer is defined

 ;   as tribal self-insured in 3P Insurer file

 ;

ELIG ;EP

 S ABMICNT=0  ;abm*2.6*15 HEAT183289

 ;mcd

 K ABMK,ABML

 K ABMILST,ABMP("STATE")  ;abm*2.6*15 HEAT161159

 K ABMTSI  ;abm*2.6*15 HEAT183289

 K ABMP("SAVE")

 S ABMP("MDFN")=""

 F  S ABMP("MDFN")=$O(^AUPNMCD("B",ABMPT,ABMP("MDFN"))) Q:'ABMP("MDFN")  D

 .Q:$P($G(^AUPNMCD(ABMP("MDFN"),0)),U)=""

 .Q:$P($G(^AUPNMCD(ABMP("MDFN"),0)),U,2)=""

 .Q:$P($G(^AUPNMCD(ABMP("MDFN"),0)),U,4)=""

 .S ABM("INS")=+$P($G(^AUPNMCD(ABMP("MDFN"),0)),U,10)

 .I 'ABM("INS") S ABM("INS")=$P($G(^AUPNMCD(ABMP("MDFN"),0)),U,2)

 .S ABM("ITYP")=$$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,ABM("INS"),".211","I"),1,"I")

 .;S ABMGRP=$S(ABM("ITYP")="D":"MCD",ABM("ITYP")="K":"CHIP",(ABM("ITYP")="P"&($D(ABMI("INS",ABM("INS"))))):"CHIP",1:"OTHR")

 .S ABMGRP=$S(ABM("ITYP")="D":"MCD",($D(ABMI("INS",ABM("INS")))):"CHIP",1:"OTHR")

 .S ABMP("DDFN")=0

 .F  S ABMP("DDFN")=$O(^AUPNMCD(ABMP("MDFN"),11,ABMP("DDFN"))) Q:'ABMP("DDFN")  D

 ..S ABMP("SDT")=+$P($G(^AUPNMCD(ABMP("MDFN"),11,ABMP("DDFN"),0)),U)

 ..S ABMP("EDT")=+$P($G(^AUPNMCD(ABMP("MDFN"),11,ABMP("DDFN"),0)),U,2)

 ..D ENROLL2

 I +$G(ABMP("SAVE"))'=0 S ABMP("MDFN")=ABMP("SAVE")  ;abm*2.6*15 HEAT164125

 ;pi

 S ABMI=0

 F  S ABMI=$O(^AUPNPRVT(ABMPT,11,ABMI)) Q:'ABMI  D

 .S ABM("INS")=+$P($G(^AUPNPRVT(ABMPT,11,ABMI,0)),U)

 .S ABM("ITYP")=$$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,ABM("INS"),".211","I"),1,"I")

 .;S ABMGRP=$S(ABM("ITYP")="D":"MCD",ABM("ITYP")="K":"CHIP",(ABM("ITYP")="P"&($D(ABMI("INS",ABM("INS"))))):"CHIP",1:"OTHR")

 .S ABMGRP=$S(ABM("ITYP")="D":"MCD",($D(ABMI("INS",ABM("INS")))):"CHIP",1:"OTHR")

 .S ABMP("SDT")=+$P($G(^AUPNPRVT(ABMPT,11,ABMI,0)),U,6)

 .S ABMP("EDT")=+$P($G(^AUPNPRVT(ABMPT,11,ABMI,0)),U,7)

 .D ENROLL2

 ;mcr

 S ABM("INS")=+$P($G(^AUPNMCR(ABMPT,0)),U,2)

 S ABM("ITYP")=$$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,ABM("INS"),".211","I"),1,"I")

 ;S ABMGRP=$S(ABM("ITYP")="D":"MCD",ABM("ITYP")="K":"CHIP",(ABM("ITYP")="P"&($D(ABMI("INS",ABM("INS"))))):"CHIP",1:"OTHR")

 S ABMGRP=$S(ABM("ITYP")="D":"MCD",($D(ABMI("INS",ABM("INS")))):"CHIP",1:"OTHR")

 S ABMI=0

 F  S ABMI=$O(^AUPNMCR(ABMPT,11,ABMI)) Q:'ABMI  D

 .S ABMP("SDT")=+$P($G(^AUPNMCR(ABMPT,11,ABMI,0)),U)

 .S ABMP("EDT")=+$P($G(^AUPNMCR(ABMPT,11,ABMI,0)),U,2)

 .D ENROLL2

 ;rr

 S ABM("INS")=+$P($G(^AUPNRRE(ABMPT,0)),U,2)

 S ABM("ITYP")=$$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,ABM("INS"),".211","I"),1,"I")

 ;S ABMGRP=$S(ABM("ITYP")="D":"MCD",ABM("ITYP")="K":"CHIP",(ABM("ITYP")="P"&($D(ABMI("INS",ABM("INS"))))):"CHIP",1:"OTHR")

 S ABMGRP=$S(ABM("ITYP")="D":"MCD",($D(ABMI("INS",ABM("INS")))):"CHIP",1:"OTHR")

 S ABMI=0

 F  S ABMI=$O(^AUPNRRE(ABMPT,11,ABMI)) Q:'ABMI  D

 .S ABMP("SDT")=+$P($G(^AUPNRRE(ABMPT,11,ABMI,0)),U)

 .S ABMP("EDT")=+$P($G(^AUPNRRE(ABMPT,11,ABMI,0)),U,2)

 .D ENROLL2

 Q

ENROLL2 ;EP

 S:($G(ABMTSI)="") ABMTSI=$P($G(^ABMNINS(ABMVLOC,ABM("INS"),0)),U,11)  ;tribal self-insured flag  ;abm*2.6*15 HEAT183289

 I ABM("ITYP")="I"!(ABM("ITYP")="N") Q

 I $P(ABMP("VDT"),".")<ABMP("SDT") Q  ;vst before start dt

 I ABMP("EDT")'=0,($P(ABMP("VDT"),".")>ABMP("EDT")) Q  ;vst after end dt

 S ABML(ABMGRP)=1

 S ABMK($S(($D(ABMI("INS",ABM("INS")))):"K",1:ABM("ITYP")))=1

 ;I ABMGRP="MCD" S ABMP("SAVE")=ABMP("MDFN")  ;abm*2.6*15 HEAT164125

 ;start new abm*2.6*15 HEAT164125

 I ABMGRP="CHIP",+$G(ABMP("SAVE"))'=0 K ABMP("SAVE"),ABMILST("STATE")

 I ABMGRP="MCD" D

 .I +$G(ABMP("SAVE"))'=0 K ABMP("SAVE"),ABMILST("STATE")

 S ABMP("SAVE")=ABMP("MDFN"),ABMILST("STATE",ABM("INS"))=$$GET1^DIQ(5,$$GET1^DIQ(9000004,ABMP("MDFN"),".04","I"),1,"E")

 ;end new HEAT164125

 S ABMILST(ABM("INS"))=ABM("ITYP")  ;abm*2.6*15 HEAT161159 - to track pt's insurers

 S ABMICNT=+$G(ABMICNT)+1  ;abm*2.6*15 HEAT183289

 Q

ABMM2PV8  ;IHS/SD/SDR - MU Patient Volume EP Report ;

 +1       ;;2.6;IHS 3P BILLING SYSTEM;**12,15**;NOV 12, 2009;Build 251

 +2       ;IHS/SD/SDR - 2.6*15 - HEAT161159 - Made change to correct duplicates; also made changes to resolve summary not reconciling to pt list

 +3       ;IHS/SD/SDR - 2.6*15 - HEAT183289 - Added code for Tribal self-insured; will look if patient has only one insurer and that insurer is defined

 +4       ;   as tribal self-insured in 3P Insurer file

 +5       ;

ELIG      ;EP

 +1       ;abm*2.6*15 HEAT183289

           SET ABMICNT=0

 +2       ;mcd

 +3        KILL ABMK,ABML

 +4       ;abm*2.6*15 HEAT161159

           KILL ABMILST,ABMP("STATE")

 +5       ;abm*2.6*15 HEAT183289

           KILL ABMTSI

 +6        KILL ABMP("SAVE")

 +7        SET ABMP("MDFN")=""

 +8        FOR 

               SET ABMP("MDFN")=$ORDER(^AUPNMCD("B",ABMPT,ABMP("MDFN")))

               IF 'ABMP("MDFN")

                   QUIT 

               Begin DoDot:1

 +9                IF $PIECE($GET(^AUPNMCD(ABMP("MDFN"),0)),U)=""

                       QUIT 

 +10               IF $PIECE($GET(^AUPNMCD(ABMP("MDFN"),0)),U,2)=""

                       QUIT 

 +11               IF $PIECE($GET(^AUPNMCD(ABMP("MDFN"),0)),U,4)=""

                       QUIT 

 +12               SET ABM("INS")=+$PIECE($GET(^AUPNMCD(ABMP("MDFN"),0)),U,10)

 +13               IF 'ABM("INS")

                       SET ABM("INS")=$PIECE($GET(^AUPNMCD(ABMP("MDFN"),0)),U,2)

 +14               SET ABM("ITYP")=$$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,ABM("INS"),".211","I"),1,"I")

 +15      ;S ABMGRP=$S(ABM("ITYP")="D":"MCD",ABM("ITYP")="K":"CHIP",(ABM("ITYP")="P"&($D(ABMI("INS",ABM("INS"))))):"CHIP",1:"OTHR")

 +16               SET ABMGRP=$SELECT(ABM("ITYP")="D":"MCD",($DATA(ABMI("INS",ABM("INS")))):"CHIP",1:"OTHR")

 +17               SET ABMP("DDFN")=0

 +18               FOR 

                       SET ABMP("DDFN")=$ORDER(^AUPNMCD(ABMP("MDFN"),11,ABMP("DDFN")))

                       IF 'ABMP("DDFN")

                           QUIT 

                       Begin DoDot:2

 +19                       SET ABMP("SDT")=+$PIECE($GET(^AUPNMCD(ABMP("MDFN"),11,ABMP("DDFN"),0)),U)

 +20                       SET ABMP("EDT")=+$PIECE($GET(^AUPNMCD(ABMP("MDFN"),11,ABMP("DDFN"),0)),U,2)

 +21                       DO ENROLL2

                       End DoDot:2

               End DoDot:1

 +22      ;abm*2.6*15 HEAT164125

           IF +$GET(ABMP("SAVE"))'=0

               SET ABMP("MDFN")=ABMP("SAVE")

 +23      ;pi

 +24       SET ABMI=0

 +25       FOR 

               SET ABMI=$ORDER(^AUPNPRVT(ABMPT,11,ABMI))

               IF 'ABMI

                   QUIT 

               Begin DoDot:1

 +26               SET ABM("INS")=+$PIECE($GET(^AUPNPRVT(ABMPT,11,ABMI,0)),U)

 +27               SET ABM("ITYP")=$$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,ABM("INS"),".211","I"),1,"I")

 +28      ;S ABMGRP=$S(ABM("ITYP")="D":"MCD",ABM("ITYP")="K":"CHIP",(ABM("ITYP")="P"&($D(ABMI("INS",ABM("INS"))))):"CHIP",1:"OTHR")

 +29               SET ABMGRP=$SELECT(ABM("ITYP")="D":"MCD",($DATA(ABMI("INS",ABM("INS")))):"CHIP",1:"OTHR")

 +30               SET ABMP("SDT")=+$PIECE($GET(^AUPNPRVT(ABMPT,11,ABMI,0)),U,6)

 +31               SET ABMP("EDT")=+$PIECE($GET(^AUPNPRVT(ABMPT,11,ABMI,0)),U,7)

 +32               DO ENROLL2

               End DoDot:1

 +33      ;mcr

 +34       SET ABM("INS")=+$PIECE($GET(^AUPNMCR(ABMPT,0)),U,2)

 +35       SET ABM("ITYP")=$$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,ABM("INS"),".211","I"),1,"I")

 +36      ;S ABMGRP=$S(ABM("ITYP")="D":"MCD",ABM("ITYP")="K":"CHIP",(ABM("ITYP")="P"&($D(ABMI("INS",ABM("INS"))))):"CHIP",1:"OTHR")

 +37       SET ABMGRP=$SELECT(ABM("ITYP")="D":"MCD",($DATA(ABMI("INS",ABM("INS")))):"CHIP",1:"OTHR")

 +38       SET ABMI=0

 +39       FOR 

               SET ABMI=$ORDER(^AUPNMCR(ABMPT,11,ABMI))

               IF 'ABMI

                   QUIT 

               Begin DoDot:1

 +40               SET ABMP("SDT")=+$PIECE($GET(^AUPNMCR(ABMPT,11,ABMI,0)),U)

 +41               SET ABMP("EDT")=+$PIECE($GET(^AUPNMCR(ABMPT,11,ABMI,0)),U,2)

 +42               DO ENROLL2

               End DoDot:1

 +43      ;rr

 +44       SET ABM("INS")=+$PIECE($GET(^AUPNRRE(ABMPT,0)),U,2)

 +45       SET ABM("ITYP")=$$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,ABM("INS"),".211","I"),1,"I")

 +46      ;S ABMGRP=$S(ABM("ITYP")="D":"MCD",ABM("ITYP")="K":"CHIP",(ABM("ITYP")="P"&($D(ABMI("INS",ABM("INS"))))):"CHIP",1:"OTHR")

 +47       SET ABMGRP=$SELECT(ABM("ITYP")="D":"MCD",($DATA(ABMI("INS",ABM("INS")))):"CHIP",1:"OTHR")

 +48       SET ABMI=0

 +49       FOR 

               SET ABMI=$ORDER(^AUPNRRE(ABMPT,11,ABMI))

               IF 'ABMI

                   QUIT 

               Begin DoDot:1

 +50               SET ABMP("SDT")=+$PIECE($GET(^AUPNRRE(ABMPT,11,ABMI,0)),U)

 +51               SET ABMP("EDT")=+$PIECE($GET(^AUPNRRE(ABMPT,11,ABMI,0)),U,2)

 +52               DO ENROLL2

               End DoDot:1

 +53       QUIT 

ENROLL2   ;EP

 +1       ;tribal self-insured flag  ;abm*2.6*15 HEAT183289

           IF ($GET(ABMTSI)="")

               SET ABMTSI=$PIECE($GET(^ABMNINS(ABMVLOC,ABM("INS"),0)),U,11)

 +2        IF ABM("ITYP")="I"!(ABM("ITYP")="N")

               QUIT 

 +3       ;vst before start dt

           IF $PIECE(ABMP("VDT"),".")<ABMP("SDT")

               QUIT 

 +4       ;vst after end dt

           IF ABMP("EDT")'=0

               IF ($PIECE(ABMP("VDT"),".")>ABMP("EDT"))

                   QUIT 

 +5        SET ABML(ABMGRP)=1

 +6        SET ABMK($SELECT(($DATA(ABMI("INS",ABM("INS")))):"K",1:ABM("ITYP")))=1

 +7       ;I ABMGRP="MCD" S ABMP("SAVE")=ABMP("MDFN")  ;abm*2.6*15 HEAT164125

 +8       ;start new abm*2.6*15 HEAT164125

 +9        IF ABMGRP="CHIP"

               IF +$GET(ABMP("SAVE"))'=0

                   KILL ABMP("SAVE"),ABMILST("STATE")

 +10       IF ABMGRP="MCD"

               Begin DoDot:1

 +11               IF +$GET(ABMP("SAVE"))'=0

                       KILL ABMP("SAVE"),ABMILST("STATE")

               End DoDot:1

 +12       SET ABMP("SAVE")=ABMP("MDFN")

           SET ABMILST("STATE",ABM("INS"))=$$GET1^DIQ(5,$$GET1^DIQ(9000004,ABMP("MDFN"),".04","I"),1,"E")

 +13      ;end new HEAT164125

 +14      ;abm*2.6*15 HEAT161159 - to track pt's insurers

           SET ABMILST(ABM("INS"))=ABM("ITYP")

 +15      ;abm*2.6*15 HEAT183289

           SET ABMICNT=+$GET(ABMICNT)+1

 +16       QUIT