ABMDAST.m

ABMDAST ; IHS/ASDST/DMJ - APC Visit Stuff ;  

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

 ;

VAR S ABMP("ADT")=0,ABM("E")=9999999-ABMP("VDT")+1,ABM=ABM("E")-6

 F  S ABM=$O(^DPT(ABMP("PDFN"),"DA","AA",ABM)) Q:'ABM!(ABM>ABM("E"))  S ABM("D")=$O(^(ABM,0)) D  Q:ABMP("ADT")

 .Q:ABMP("VDT")>$P($G(^DPT(ABMP("PDFN"),"DA",ABM("D"),1)),U)  S ABMP("ADT")=ABM("D")

 S ABMP("VTYP")=$S(ABMP("ADT"):111,$P($G(^AAPCRCDS(ABMP("VDFN"),4)),U,14)'=3:131,1:111)

 I ABMP("VTYP")'=111 S ABM=0 F  S ABM=$O(^ABMNINS(DUZ(2),ABMP("INS"),1,ABM)) Q:'ABM  I ABM'=131,$P($G(^ABMDVTYP(ABM,0)),U,5)=ABMP("CLN") S ABMP("VTYP")=ABM Q

 K ABMP("DUP")

 I $P($G(^ABMNINS(DUZ(2),ABMP("INS"),1,ABMP("VTYP"),0)),U,7)="N" Q

 S ABMP("CDFN")=$O(^ABMDCLM(DUZ(2),"APC",ABMP("VDFN"),"")) G NEW:'+ABMP("CDFN")

 Q:'$D(^ABMDCLM(DUZ(2),ABMP("CDFN"),0))  S ABMP("DUP")="" G INS1:$P(^(0),U,4)="F"

 S DA=ABMP("CDFN"),DIE="^ABMDCLM(DUZ(2),",DR=".42///Y" D ^ABMDDIE K DR Q

 ;

NEW ;new claim

 K DIC,DD,DO,DINUM S DIC="^ABMDCLM(DUZ(2),",DIC(0)="L",X=ABMP("PDFN")

 S DINUM=$$NXNM^ABMDUTL

 I DINUM="" D  Q

 .W !!,"ERROR: Claim not created - check global ^ABMDCLM(0)"

 .D EOP^ABMDUTL(1)

 K DD,DO D FILE^DICN S ABMP("CDFN")=+Y I +Y<1 Q

 L +^ABMDCLM(DUZ(2),ABMP("CDFN")):0 I '$T Q

 S DA=+Y,DIE=DIC,DR=".02////"_$P(ABMP("VDT"),".")_";.03////"_ABMP("LDFN")_";.04////"_"F"_";.06////"_ABMP("CLN")_";.07////"_ABMP("VTYP")_";.08////"_ABMP("INS") D ^DIE

VSIT S DA(1)=ABMP("CDFN"),DIC="^ABMDCLM(DUZ(2),"_DA(1)_",15,",DIC(0)="LE"

 S DIC("P")=$P(^DD(9002274.3,15,0),U,2)

 S (X,DINUM)=ABMP("VDFN")

 K DD,DO,DR D FILE^DICN

 K DIC

INS1 I '$D(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,"B",ABMP("INS"))) D ADD^ABMDE2E

 S ABM("C")="" F  S ABM("C")=$O(ABML(ABM("PRI"),ABMP("INS"),"COV",ABM("C"))) Q:'ABM("C")  I '$D(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,ABM("XIEN"),11,ABM("C"),0)) D ADDCOV^ABMDE2E

 ;

FRATE S ABMP("C0")=^ABMDCLM(DUZ(2),ABMP("CDFN"),0),ABMX("INS")=ABMP("INS") D FRATE^ABMDE2X1,EXP^ABMDE2X5 K ABMV,ABMX

 ;

 G ^ABMDAST1

ABMDAST   ; IHS/ASDST/DMJ - APC Visit Stuff ;  

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

 +2       ;

VAR        SET ABMP("ADT")=0

           SET ABM("E")=9999999-ABMP("VDT")+1

           SET ABM=ABM("E")-6

 +1        FOR 

               SET ABM=$ORDER(^DPT(ABMP("PDFN"),"DA","AA",ABM))

               IF 'ABM!(ABM>ABM("E"))

                   QUIT 

               SET ABM("D")=$ORDER(^(ABM,0))

               Begin DoDot:1

 +2                IF ABMP("VDT")>$PIECE($GET(^DPT(ABMP("PDFN"),"DA",ABM("D"),1)),U)

                       QUIT 

                   SET ABMP("ADT")=ABM("D")

               End DoDot:1

               IF ABMP("ADT")

                   QUIT 

 +3        SET ABMP("VTYP")=$SELECT(ABMP("ADT"):111,$PIECE($GET(^AAPCRCDS(ABMP("VDFN"),4)),U,14)'=3:131,1:111)

 +4        IF ABMP("VTYP")'=111

               SET ABM=0

               FOR 

                   SET ABM=$ORDER(^ABMNINS(DUZ(2),ABMP("INS"),1,ABM))

                   IF 'ABM

                       QUIT 

                   IF ABM'=131

                       IF $PIECE($GET(^ABMDVTYP(ABM,0)),U,5)=ABMP("CLN")

                           SET ABMP("VTYP")=ABM

                           QUIT 

 +5        KILL ABMP("DUP")

 +6        IF $PIECE($GET(^ABMNINS(DUZ(2),ABMP("INS"),1,ABMP("VTYP"),0)),U,7)="N"

               QUIT 

 +7        SET ABMP("CDFN")=$ORDER(^ABMDCLM(DUZ(2),"APC",ABMP("VDFN"),""))

           IF '+ABMP("CDFN")

               GOTO NEW

 +8        IF '$DATA(^ABMDCLM(DUZ(2),ABMP("CDFN"),0))

               QUIT 

           SET ABMP("DUP")=""

           IF $PIECE(^(0),U,4)="F"

               GOTO INS1

 +9        SET DA=ABMP("CDFN")

           SET DIE="^ABMDCLM(DUZ(2),"

           SET DR=".42///Y"

           DO ^ABMDDIE

           KILL DR

           QUIT 

 +10      ;

NEW       ;new claim

 +1        KILL DIC,DD,DO,DINUM

           SET DIC="^ABMDCLM(DUZ(2),"

           SET DIC(0)="L"

           SET X=ABMP("PDFN")

 +2        SET DINUM=$$NXNM^ABMDUTL

 +3        IF DINUM=""

               Begin DoDot:1

 +4                WRITE !!,"ERROR: Claim not created - check global ^ABMDCLM(0)"

 +5                DO EOP^ABMDUTL(1)

               End DoDot:1

               QUIT 

 +6        KILL DD,DO

           DO FILE^DICN

           SET ABMP("CDFN")=+Y

           IF +Y<1

               QUIT 

 +7        LOCK +^ABMDCLM(DUZ(2),ABMP("CDFN")):0

           IF '$TEST

               QUIT 

 +8        SET DA=+Y

           SET DIE=DIC

           SET DR=".02////"_$PIECE(ABMP("VDT"),".")_";.03////"_ABMP("LDFN")_";.04////"_"F"_";.06////"_ABMP("CLN")_";.07////"_ABMP("VTYP")_";.08////"_ABMP("INS")

           DO ^DIE

VSIT       SET DA(1)=ABMP("CDFN")

           SET DIC="^ABMDCLM(DUZ(2),"_DA(1)_",15,"

           SET DIC(0)="LE"

 +1        SET DIC("P")=$PIECE(^DD(9002274.3,15,0),U,2)

 +2        SET (X,DINUM)=ABMP("VDFN")

 +3        KILL DD,DO,DR

           DO FILE^DICN

 +4        KILL DIC

INS1       IF '$DATA(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,"B",ABMP("INS")))

               DO ADD^ABMDE2E

 +1        SET ABM("C")=""

           FOR 

               SET ABM("C")=$ORDER(ABML(ABM("PRI"),ABMP("INS"),"COV",ABM("C")))

               IF 'ABM("C")

                   QUIT 

               IF '$DATA(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,ABM("XIEN"),11,ABM("C"),0))

                   DO ADDCOV^ABMDE2E

 +2       ;

FRATE      SET ABMP("C0")=^ABMDCLM(DUZ(2),ABMP("CDFN"),0)

           SET ABMX("INS")=ABMP("INS")

           DO FRATE^ABMDE2X1

           DO EXP^ABMDE2X5

           KILL ABMV,ABMX

 +1       ;

 +2        GOTO ^ABMDAST1