Routine: ABMDE8K

ABMDE8K ; IHS/SD/SDR - Page 8 - AMBULANCE INFO ;

 ;;2.6;IHS 3P BILLING SYSTEM;**10,21**;NOV 12, 2009;Build 379

 ; IHS/SD/SDR - v2.5 p8 - task 6

 ;   New routine for page 8K-ambulance

 ; IHS/SD/SDR - v2.5 p10 - IM9843

 ;   Added new prompt SERVICE TO DATE/TIME

 ; IHS/SD/SDR - v2.5 p11 - NPI

 ; IHS/SD/SDR - v2.6 CSV

 ;IHS/SD/AML - 2.6*21 - HEAT155818 - Made it so the modifier can be edited.

DISP K ABMZ S ABMZ("TITL")="AMBULANCE SERVICES",ABMZ("PG")="8K"

 I $D(ABMP("DDL")),$Y>(IOSL-9) D PAUSE^ABMDE1 G:$D(DUOUT)!$D(DTOUT)!$D(DIROUT) XIT I 1

 E  D SUM^ABMDE1

AMB ; Amb. Services

 S ABMZ("CAT")=13

 S ABMZ("SUB")=47

 D MODE^ABMDE8X

 S:((^ABMDEXP(ABMMODE(8),0)["HCFA")!(^ABMDEXP(ABMMODE(8),0)["CMS")) ABMZ("DIAG")=";.06"

 S ABMZ("DR")=";W !;.07//"_$$SDT^ABMDUTL(ABMP("VDT"))_";W !;.12//"_$$SDT^ABMDUTL(ABMP("VDT"))_";.03;.11"

 S ABMZ("CHRG")=";.04"

 S ABMZ("ITEM")="Amb. Services (HCPCS Code)"

 S ABMZ("DIC")="^ICPT(",ABMZ("X")="X",ABMZ("MAX")=10,ABMZ("TOTL")=0

 I ^ABMDEXP(ABMMODE(8),0)["UB" S ABMZ("DR")=";W !;.02"_ABMZ("DR")

 D K^ABMDE8X

 D HD G LOOP

HD W !?5,"REVN",?60,"UNIT",?71,"TOTAL"

 W !?5,"CODE",?10,"        HCPCS - AMBULANCE SERVICES",?59,"CHARGE",?66,"QTY",?71,"CHARGE"

 W !?5,"====",?10,"===============================================",?59,"======",?66,"===",?70,"========="

LOOP S (ABMZ("LNUM"),ABMZ("NUM"),ABMZ(1),ABM)=0 F ABM("I")=1:1 S ABM=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),47,ABM)) Q:'ABM  S ABM("X")=ABM,ABMZ("NUM")=ABM("I") D PC1

 ;S ABMZ("MOD")=.05_U_5_.08_U_.09  ;abm*2.6*21 IHS/SD/AML HEAT155818

 S ABMZ("MOD")=.05_U_5_U_.08_U_.09  ;abm*2.6*21 IHS/SD/AML HEAT155818

 I ABMZ("NUM")>0 W !?69,"==========",!?69,$J("$"_($FN(ABMZ("TOTL"),",",2)),10)

 I +$O(ABME(0)) S ABME("CONT")="" D ^ABMDERR K ABME("CONT")

 G XIT

PC1 S ABM("X0")=^ABMDCLM(DUZ(2),ABMP("CDFN"),47,ABM("X"),0),ABM("X")=$P(^(0),U)

 S ABMZ("UNIT")=$P(ABM("X0"),U,3)

 S:'+ABMZ("UNIT") ABMZ("UNIT")=1

 S ABMZ(ABM("I"))=$P($$CPT^ABMCVAPI($P(ABM("X0"),U),ABMP("VDT")),U,2)_U_ABM_U_$P(ABM("X0"),U,2)  ;CSV-c

EOP I $Y>(IOSL-5) D PAUSE^ABMDE1,HD

 W !,"[",ABM("I"),"]"

 I $P(ABM("X0"),"^",7) D

 .W ?5,"CHARGE DATE: "

 .W $$CDT^ABMDUTL($P(ABM("X0"),"^",7))

 .I $P(ABM("X0"),U,12)'="",($P(ABM("X0"),U,12)'=$P(ABM("X0"),U,7)) W "-",$$CDT^ABMDUTL($P(ABM("X0"),U,12))

 .I $P(ABM("X0"),U,11) D

 ..W " ("_$P($G(^VA(200,$P(ABM("X0"),U,11),0)),U)_")"

 .W !

 W ?6,$P(ABM("X0"),"^",2)

 W ?10,$P(ABMZ(ABM("I")),U)

 S ABMZ("MOD")=""

 F ABM("M")=5,8,9 S:$P(ABM("X0"),U,ABM("M"))]"" ABMZ("MOD")=ABMZ("MOD")_"-"_$P(ABM("X0"),U,ABM("M"))

 W ?10 W:ABMZ("MOD")]"" ABMZ("MOD")_" "

 K ABMU S ABMU(1)="?59"_U_$J($P(ABM("X0"),U,4),6,2)

 S ABMU(2)="?66"_U_$J(ABMZ("UNIT"),2)

 S ABMU(3)="?70"_U_$J($FN((ABMZ("UNIT")*$P(ABM("X0"),U,4)),",",2),9)

 S ABMZ("TOTL")=(ABMZ("UNIT")*$P(ABM("X0"),U,4))+ABMZ("TOTL")

 I $P(^ABMDPARM(DUZ(2),1,0),U,14)'="Y" S ABMU("TXT")=$P($$CPT^ABMCVAPI($P(ABM("X0"),U),ABMP("VDT")),U,3)  ;CSV-c

 ;start CSV-c

 E  D

 .S ABMU("TXT")=""

 .K ABMZCPTD  ;abm*2.6*10 HEAT56410

 .;D IHSCPTD^ABMCVAPI($P(ABM("X0"),U),ABMZCPTD,"",ABMP("VDT"))  ;abm*2.6*10 HEAT56410

 .D IHSCPTD^ABMCVAPI($P(ABM("X0"),U),"ABMZCPTD","",ABMP("VDT"))  ;abm*2.6*10 HEAT56410

 .S ABM("CP")=0

 .;F  S ABM("CP")=$O(ABMZCPTD(ABM("CP"))) Q:'$D(ABMZCPTD(ABM("CP")))  D  ;abm*2.6*10 HEAT56410

 .F  S ABM("CP")=$O(ABMZCPTD(ABM("CP"))) Q:(+ABM("CP")=0)  D  ;abm*2.6*10 HEAT56410

 ..S ABMU("TXT")=ABMU("TXT")_ABMZCPTD(ABM("CP"))_" "

 ;end CSV-c

 I ABMU("TXT")]"" S ABMU("RM")=59,ABMU("LM")=16 D ^ABMDWRAP I 1

 E  W ?17,$P(^ICPT($P(ABM("X0"),U),0),U,2)

XIT K ABM,ABMMODE

ABMDE8K   ; IHS/SD/SDR - Page 8 - AMBULANCE INFO ;

 +1       ;;2.6;IHS 3P BILLING SYSTEM;**10,21**;NOV 12, 2009;Build 379

 +2       ;

 +3       ; IHS/SD/SDR - v2.5 p8 - task 6

 +4       ;   New routine for page 8K-ambulance

 +5       ; IHS/SD/SDR - v2.5 p10 - IM9843

 +6       ;   Added new prompt SERVICE TO DATE/TIME

 +7       ; IHS/SD/SDR - v2.5 p11 - NPI

 +8       ;

 +9       ; IHS/SD/SDR - v2.6 CSV

 +10      ;IHS/SD/AML - 2.6*21 - HEAT155818 - Made it so the modifier can be edited.

 +11      ;

DISP       KILL ABMZ

           SET ABMZ("TITL")="AMBULANCE SERVICES"

           SET ABMZ("PG")="8K"

 +1        IF $DATA(ABMP("DDL"))

               IF $Y>(IOSL-9)

                   DO PAUSE^ABMDE1

                   IF $DATA(DUOUT)!$DATA(DTOUT)!$DATA(DIROUT)

                       GOTO XIT

                   IF 1

 +2       IF '$TEST

               DO SUM^ABMDE1

 +3       ;

AMB       ; Amb. Services

 +1        SET ABMZ("CAT")=13

 +2        SET ABMZ("SUB")=47

 +3        DO MODE^ABMDE8X

 +4        IF ((^ABMDEXP(ABMMODE(8),0)["HCFA")!(^ABMDEXP(ABMMODE(8),0)["CMS"))

               SET ABMZ("DIAG")=";.06"

 +5        SET ABMZ("DR")=";W !;.07//"_$$SDT^ABMDUTL(ABMP("VDT"))_";W !;.12//"_$$SDT^ABMDUTL(ABMP("VDT"))_";.03;.11"

 +6        SET ABMZ("CHRG")=";.04"

 +7        SET ABMZ("ITEM")="Amb. Services (HCPCS Code)"

 +8        SET ABMZ("DIC")="^ICPT("

           SET ABMZ("X")="X"

           SET ABMZ("MAX")=10

           SET ABMZ("TOTL")=0

 +9        IF ^ABMDEXP(ABMMODE(8),0)["UB"

               SET ABMZ("DR")=";W !;.02"_ABMZ("DR")

 +10       DO K^ABMDE8X

 +11       DO HD

           GOTO LOOP

HD         WRITE !?5,"REVN",?60,"UNIT",?71,"TOTAL"

 +1        WRITE !?5,"CODE",?10,"        HCPCS - AMBULANCE SERVICES",?59,"CHARGE",?66,"QTY",?71,"CHARGE"

 +2        WRITE !?5,"====",?10,"===============================================",?59,"======",?66,"===",?70,"========="

 +3        QUIT

LOOP       SET (ABMZ("LNUM"),ABMZ("NUM"),ABMZ(1),ABM)=0

           FOR ABM("I")=1:1

               SET ABM=$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),47,ABM))

               IF 'ABM

                   QUIT

               SET ABM("X")=ABM

               SET ABMZ("NUM")=ABM("I")

               DO PC1

 +1       ;S ABMZ("MOD")=.05_U_5_.08_U_.09  ;abm*2.6*21 IHS/SD/AML HEAT155818

 +2       ;abm*2.6*21 IHS/SD/AML HEAT155818

           SET ABMZ("MOD")=.05_U_5_U_.08_U_.09

 +3        IF ABMZ("NUM")>0

               WRITE !?69,"==========",!?69,$JUSTIFY("$"_($FNUMBER(ABMZ("TOTL"),",",2)),10)

 +4        IF +$ORDER(ABME(0))

               SET ABME("CONT")=""

               DO ^ABMDERR

               KILL ABME("CONT")

 +5        GOTO XIT

 +6       ;

PC1        SET ABM("X0")=^ABMDCLM(DUZ(2),ABMP("CDFN"),47,ABM("X"),0)

           SET ABM("X")=$PIECE(^(0),U)

 +1        SET ABMZ("UNIT")=$PIECE(ABM("X0"),U,3)

 +2        IF '+ABMZ("UNIT")

               SET ABMZ("UNIT")=1

 +3       ;CSV-c

           SET ABMZ(ABM("I"))=$PIECE($$CPT^ABMCVAPI($PIECE(ABM("X0"),U),ABMP("VDT")),U,2)_U_ABM_U_$PIECE(ABM("X0"),U,2)

EOP        IF $Y>(IOSL-5)

               DO PAUSE^ABMDE1

               DO HD

 +1        WRITE !,"[",ABM("I"),"]"

 +2        IF $PIECE(ABM("X0"),"^",7)

               Begin DoDot:1

 +3                WRITE ?5,"CHARGE DATE: "

 +4                WRITE $$CDT^ABMDUTL($PIECE(ABM("X0"),"^",7))

 +5                IF $PIECE(ABM("X0"),U,12)'=""

                       IF ($PIECE(ABM("X0"),U,12)'=$PIECE(ABM("X0"),U,7))

                           WRITE "-",$$CDT^ABMDUTL($PIECE(ABM("X0"),U,12))

 +6                IF $PIECE(ABM("X0"),U,11)

                       Begin DoDot:2

 +7                        WRITE " ("_$PIECE($GET(^VA(200,$PIECE(ABM("X0"),U,11),0)),U)_")"

                       End DoDot:2

 +8                WRITE !

               End DoDot:1

 +9        WRITE ?6,$PIECE(ABM("X0"),"^",2)

 +10       WRITE ?10,$PIECE(ABMZ(ABM("I")),U)

 +11       SET ABMZ("MOD")=""

 +12       FOR ABM("M")=5,8,9

               IF $PIECE(ABM("X0"),U,ABM("M"))]""

                   SET ABMZ("MOD")=ABMZ("MOD")_"-"_$PIECE(ABM("X0"),U,ABM("M"))

 +13       WRITE ?10

           IF ABMZ("MOD")]""

               WRITE ABMZ("MOD")_" "

 +14       KILL ABMU

           SET ABMU(1)="?59"_U_$JUSTIFY($PIECE(ABM("X0"),U,4),6,2)

 +15       SET ABMU(2)="?66"_U_$JUSTIFY(ABMZ("UNIT"),2)

 +16       SET ABMU(3)="?70"_U_$JUSTIFY($FNUMBER((ABMZ("UNIT")*$PIECE(ABM("X0"),U,4)),",",2),9)

 +17       SET ABMZ("TOTL")=(ABMZ("UNIT")*$PIECE(ABM("X0"),U,4))+ABMZ("TOTL")

 +18      ;CSV-c

           IF $PIECE(^ABMDPARM(DUZ(2),1,0),U,14)'="Y"

               SET ABMU("TXT")=$PIECE($$CPT^ABMCVAPI($PIECE(ABM("X0"),U),ABMP("VDT")),U,3)

 +19      ;start CSV-c

 +20      IF '$TEST

               Begin DoDot:1

 +21               SET ABMU("TXT")=""

 +22      ;abm*2.6*10 HEAT56410

                   KILL ABMZCPTD

 +23      ;D IHSCPTD^ABMCVAPI($P(ABM("X0"),U),ABMZCPTD,"",ABMP("VDT"))  ;abm*2.6*10 HEAT56410

 +24      ;abm*2.6*10 HEAT56410

                   DO IHSCPTD^ABMCVAPI($PIECE(ABM("X0"),U),"ABMZCPTD","",ABMP("VDT"))

 +25               SET ABM("CP")=0

 +26      ;F  S ABM("CP")=$O(ABMZCPTD(ABM("CP"))) Q:'$D(ABMZCPTD(ABM("CP")))  D  ;abm*2.6*10 HEAT56410

 +27      ;abm*2.6*10 HEAT56410

FOR

                       SET ABM("CP")=$ORDER(ABMZCPTD(ABM("CP")))

                       IF (+ABM("CP")=0)

                           QUIT

                       Begin DoDot:2

 +28                       SET ABMU("TXT")=ABMU("TXT")_ABMZCPTD(ABM("CP"))_" "

                       End DoDot:2

               End DoDot:1

 +29      ;end CSV-c

 +30       IF ABMU("TXT")]""

               SET ABMU("RM")=59

               SET ABMU("LM")=16

               DO ^ABMDWRAP

               IF 1

 +31      IF '$TEST

               WRITE ?17,$PIECE(^ICPT($PIECE(ABM("X0"),U),0),U,2)

 +32       QUIT

 +33      ;

XIT        KILL ABM,ABMMODE

 +1        QUIT

ABMDE8K.m