- ABMDE8I ; IHS/ASDST/DMJ - Page 8 - DENTAL ;
- ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
- ;
- ; IHS/SD/SDR - v2.5 p11 - NPI
- ;
- DISP K ABMZ,ABME,ABM S ABMZ("TITL")="INPATIENT DENTAL SERVICES",ABMZ("PG")="8I"
- I $D(ABMP("DDL")),$Y>(IOSL-9) D PAUSE^ABMDE1 G:$D(DUOUT)!$D(DTOUT)!$D(DIROUT) XIT I 1
- E D SUM^ABMDE1
- ;
- D ^ABMDE6X K ABME(137)
- FEE S ABMZ("CAT")=21
- S ABMZ("SUB")=33
- D MODE^ABMDE8X
- S:((^ABMDEXP(ABMMODE(9),0)["HCFA")!(^ABMDEXP(ABMMODE(9),0)["CMS")) ABMZ("DIAG")=";.04"
- S ABMZ("DR")=";W !;.07//"_ABMP("VISTDT")_";W !;.05;W !;.06",ABMZ("CHRG")=";W !;.08",ABMZ("ITEM")="Dental (ADA Code)",ABMZ("DIC")="^AUTTADA(",ABMZ("X")="X",ABM("TOTL")=0
- I ^ABMDEXP(ABMMODE(9),0)["UB" S ABMZ("DR")=";W !;.02"_ABMZ("DR")
- D HD G LOOP
- HD W !?4,"VISIT",?61,"OPER"
- W !?4,"DATE",?11," INPATIENT DENTAL SERVICE",?61,"SITE",?66,"SURF",?73,"CHARGE"
- W !?4,"=====",?11,"================================================",?61,"====",?66,"=====",?73,"======"
- Q
- LOOP S (ABMZ("LNUM"),ABMZ("NUM"),ABMZ(1),ABM)=0 F ABM("I")=1:1 D Q:'ABM D PC1 Q:$D(DUOUT)!$D(DTOUT)!$D(DIROUT)
- .I +ABM,$D(ABM("X")) S ABM("X")=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),33,"C",ABM,ABM("X"))) I +ABM("X") S ABMZ("NUM")=ABM("I") Q
- .S ABM=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),33,"C",ABM)) Q:'ABM S ABM("X")=$O(^(ABM,"")),ABMZ("NUM")=ABM("I")
- .Q
- W !?72,"=======",!?70,$J(("$"_$FN(ABM("TOTL"),",",2)),9)
- I +$O(ABME(0)) S ABME("CONT")="" D ^ABMDERR K ABME("CONT")
- G XIT
- ;
- PC1 S ABM("X0")=^ABMDCLM(DUZ(2),ABMP("CDFN"),33,ABM("X"),0)
- S ABMZ(ABM("I"))=$P(^AUTTADA(+ABM("X0"),0),U)_U_ABM("X")
- EOP I $Y>(IOSL-5) D PAUSE^ABMDE1,HD
- W !,"[",ABM("I"),"]"
- I $P(ABM("X0"),U,7)]"" W ?4,$E($P(ABM("X0"),U,7),4,5)_"/"_$E($P(ABM("X0"),U,7),6,7)
- W ?11,$P(^AUTTADA(+ABM("X0"),0),U)," ",$E($P(^(0),U,2),1,43)
- W ?62 W $S($P(ABM("X0"),U,5)="":"",$D(^ADEOPS($P(ABM("X0"),U,5),88)):$P(^(88),U),1:"")
- W ?66,$J($P(ABM("X0"),U,6),4)
- W ?73,$J($FN($P(ABM("X0"),U,8),",",2),6)
- S ABM("TOTL")=ABM("TOTL")+$P(ABM("X0"),U,8)
- Q
- ;
- XIT K ABM,ABMMODE
- Q
- ;
- V1 S ABMZ("TITL")="DENTAL VIEW OPTION" D SUM^ABMDE1
- D ^ABMDERR
- Q
- ABMDE8I ; IHS/ASDST/DMJ - Page 8 - DENTAL ;
- +1 ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
- +2 ;
- +3 ; IHS/SD/SDR - v2.5 p11 - NPI
- +4 ;
- DISP KILL ABMZ,ABME,ABM
- SET ABMZ("TITL")="INPATIENT DENTAL SERVICES"
- SET ABMZ("PG")="8I"
- +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 ;
- +4 DO ^ABMDE6X
- KILL ABME(137)
- FEE SET ABMZ("CAT")=21
- +1 SET ABMZ("SUB")=33
- +2 DO MODE^ABMDE8X
- +3 IF ((^ABMDEXP(ABMMODE(9),0)["HCFA")!(^ABMDEXP(ABMMODE(9),0)["CMS"))
- SET ABMZ("DIAG")=";.04"
- +4 SET ABMZ("DR")=";W !;.07//"_ABMP("VISTDT")_";W !;.05;W !;.06"
- SET ABMZ("CHRG")=";W !;.08"
- SET ABMZ("ITEM")="Dental (ADA Code)"
- SET ABMZ("DIC")="^AUTTADA("
- SET ABMZ("X")="X"
- SET ABM("TOTL")=0
- +5 IF ^ABMDEXP(ABMMODE(9),0)["UB"
- SET ABMZ("DR")=";W !;.02"_ABMZ("DR")
- +6 DO HD
- GOTO LOOP
- HD WRITE !?4,"VISIT",?61,"OPER"
- +1 WRITE !?4,"DATE",?11," INPATIENT DENTAL SERVICE",?61,"SITE",?66,"SURF",?73,"CHARGE"
- +2 WRITE !?4,"=====",?11,"================================================",?61,"====",?66,"=====",?73,"======"
- +3 QUIT
- LOOP SET (ABMZ("LNUM"),ABMZ("NUM"),ABMZ(1),ABM)=0
- FOR ABM("I")=1:1
- Begin DoDot:1
- +1 IF +ABM
- IF $DATA(ABM("X"))
- SET ABM("X")=$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),33,"C",ABM,ABM("X")))
- IF +ABM("X")
- SET ABMZ("NUM")=ABM("I")
- QUIT
- +2 SET ABM=$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),33,"C",ABM))
- IF 'ABM
- QUIT
- SET ABM("X")=$ORDER(^(ABM,""))
- SET ABMZ("NUM")=ABM("I")
- +3 QUIT
- End DoDot:1
- IF 'ABM
- QUIT
- DO PC1
- IF $DATA(DUOUT)!$DATA(DTOUT)!$DATA(DIROUT)
- QUIT
- +4 WRITE !?72,"=======",!?70,$JUSTIFY(("$"_$FNUMBER(ABM("TOTL"),",",2)),9)
- +5 IF +$ORDER(ABME(0))
- SET ABME("CONT")=""
- DO ^ABMDERR
- KILL ABME("CONT")
- +6 GOTO XIT
- +7 ;
- PC1 SET ABM("X0")=^ABMDCLM(DUZ(2),ABMP("CDFN"),33,ABM("X"),0)
- +1 SET ABMZ(ABM("I"))=$PIECE(^AUTTADA(+ABM("X0"),0),U)_U_ABM("X")
- EOP IF $Y>(IOSL-5)
- DO PAUSE^ABMDE1
- DO HD
- +1 WRITE !,"[",ABM("I"),"]"
- +2 IF $PIECE(ABM("X0"),U,7)]""
- WRITE ?4,$EXTRACT($PIECE(ABM("X0"),U,7),4,5)_"/"_$EXTRACT($PIECE(ABM("X0"),U,7),6,7)
- +3 WRITE ?11,$PIECE(^AUTTADA(+ABM("X0"),0),U)," ",$EXTRACT($PIECE(^(0),U,2),1,43)
- +4 WRITE ?62
- WRITE $SELECT($PIECE(ABM("X0"),U,5)="":"",$DATA(^ADEOPS($PIECE(ABM("X0"),U,5),88)):$PIECE(^(88),U),1:"")
- +5 WRITE ?66,$JUSTIFY($PIECE(ABM("X0"),U,6),4)
- +6 WRITE ?73,$JUSTIFY($FNUMBER($PIECE(ABM("X0"),U,8),",",2),6)
- +7 SET ABM("TOTL")=ABM("TOTL")+$PIECE(ABM("X0"),U,8)
- +8 QUIT
- +9 ;
- XIT KILL ABM,ABMMODE
- +1 QUIT
- +2 ;
- V1 SET ABMZ("TITL")="DENTAL VIEW OPTION"
- DO SUM^ABMDE1
- +1 DO ^ABMDERR
- +2 QUIT
