- ABMDE9A ; IHS/ASDST/DMJ - Page 9 - UB-82 CODES-Cont ;
- ;;2.6;IHS 3P BILLING SYSTEM;**11**;NOV 12, 2009;Build 133
- ;
- ; IHS/SD/SDR - v2.5 p8 - task 6
- ; Added code to put Zip code for AO on page 9D
- ;
- DISP3 ;EP - Entry Point for Condition Codes
- K ABMZ S ABMZ("TITL")="CONDITION CODES",ABMZ("PG")="9C"
- I $D(ABMP("DDL")),$Y>(IOSL-9) D PAUSE^ABMDE1 G:$D(DUOUT)!$D(DTOUT)!$D(DIROUT) XIT I 1
- E D SUM^ABMDE1
- ;
- COND ; Condition codes
- S ABMZ("SUB")=53,ABMZ("DR")="",ABMZ("ITEM")="Condition Code",ABMZ("DIC")="^ABMDCODE(",ABMZ("X")="DINUM",ABMZ("MAX")=5
- D HD3 G LOOP3
- HD3 W !?6,"COND"
- W !?6,"CODE",?14," CONDITION CODE DESCRIPTION"
- W !?6,"====",?14,"============================================================"
- Q
- LOOP3 S (ABMZ("LNUM"),ABMZ("NUM"),ABMZ(1))=0,ABM=0 F ABM("I")=1:1 S ABM=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),53,ABM)) Q:'ABM S ABM("X")=ABM,ABMZ("NUM")=ABM("I") D COND1
- I +$O(ABME(0)) S ABME("CONT")="" D ^ABMDERR K ABME("CONT")
- Q
- COND1 S ABM("X0")=^ABMDCLM(DUZ(2),ABMP("CDFN"),53,ABM("X"),0),ABM("X")=$P(^(0),U)
- S ABMZ(ABM("I"))=$E(("00"_$P(^ABMDCODE(ABM("X"),0),U)),$L($P(^(0),U))+1,4)_U_ABM_U_$P(ABM("X0"),U,2)
- I $Y>(IOSL-5) D PAUSE^ABMDE1 G:$D(DUOUT)!$D(DTOUT)!$D(DIROUT) XIT D HD3
- W !,"[",ABM("I"),"]",?7,$P(ABMZ(ABM("I")),U),?14,$P(^ABMDCODE(ABM("X"),0),U,3)
- Q
- ;
- DISP4 ;EP - Entry Point for Value Codes
- K ABMZ S ABMZ("TITL")="VALUE CODES",ABMZ("PG")="9D"
- I $D(ABMP("DDL")),$Y>(IOSL-9) D PAUSE^ABMDE1 G:$D(DUOUT)!$D(DTOUT)!$D(DIROUT) XIT I 1
- E D SUM^ABMDE1
- ;
- VALU ; Value codes
- S ABMZ("SUB")=55
- S ABMZ("DR")=";W !;.02Amount OR Zip Code"
- S ABMZ("ITEM")="Value Code"
- S ABMZ("DIC")="^ABMDCODE("
- S ABMZ("X")="DINUM"
- S ABMZ("MAX")=4
- D HD4 G LOOP4
- HD4 W !?6,"VALU"
- W !?6,"CODE",?14," VALUE CODE DESCRIPTION",?67,"AMOUNT"
- W !?6,"====",?14,"==================================================",?66,"========"
- Q
- LOOP4 S (ABMZ("LNUM"),ABMZ("NUM"),ABMZ(1))=0,ABM=0 F ABM("I")=1:1 S ABM=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),55,ABM)) Q:'ABM S ABM("X")=ABM,ABMZ("NUM")=ABM("I") D VALU1
- I +$O(ABME(0)) S ABME("CONT")="" D ^ABMDERR K ABME("CONT")
- Q
- VALU1 S ABM("X0")=^ABMDCLM(DUZ(2),ABMP("CDFN"),55,ABM("X"),0),ABM("X")=$P(^(0),U)
- S ABMZ(ABM("I"))=$E(("00"_$P(^ABMDCODE(ABM("X"),0),U)),$L($P(^(0),U))+1,4)_U_ABM_U_$P(ABM("X0"),U,2)
- I $Y>(IOSL-5) D PAUSE^ABMDE1 G:$D(DUOUT)!$D(DTOUT)!$D(DIROUT) XIT D HD4
- W !,"[",ABM("I"),"]",?7,$P(ABMZ(ABM("I")),U)
- W ?14,$P(^ABMDCODE(ABM("X"),0),U,3)
- ;W ?66,$S("A0^32"[$P(ABMZ(ABM("I")),U):$P(ABM("X0"),U,2),1:$J($P(ABM("X0"),U,2),8,2)) ;abm*2.6*11 HEAT89676
- W ?66,$S("A0^32^80^82^83"[$P(ABMZ(ABM("I")),U):$P(ABM("X0"),U,2),1:$J($P(ABM("X0"),U,2),8,2)) ;abm*2.6*11 HEAT89676
- Q
- ;
- XIT Q
- ABMDE9A ; IHS/ASDST/DMJ - Page 9 - UB-82 CODES-Cont ;
- +1 ;;2.6;IHS 3P BILLING SYSTEM;**11**;NOV 12, 2009;Build 133
- +2 ;
- +3 ; IHS/SD/SDR - v2.5 p8 - task 6
- +4 ; Added code to put Zip code for AO on page 9D
- +5 ;
- DISP3 ;EP - Entry Point for Condition Codes
- +1 KILL ABMZ
- SET ABMZ("TITL")="CONDITION CODES"
- SET ABMZ("PG")="9C"
- +2 IF $DATA(ABMP("DDL"))
- IF $Y>(IOSL-9)
- DO PAUSE^ABMDE1
- IF $DATA(DUOUT)!$DATA(DTOUT)!$DATA(DIROUT)
- GOTO XIT
- IF 1
- +3 IF '$TEST
- DO SUM^ABMDE1
- +4 ;
- COND ; Condition codes
- +1 SET ABMZ("SUB")=53
- SET ABMZ("DR")=""
- SET ABMZ("ITEM")="Condition Code"
- SET ABMZ("DIC")="^ABMDCODE("
- SET ABMZ("X")="DINUM"
- SET ABMZ("MAX")=5
- +2 DO HD3
- GOTO LOOP3
- HD3 WRITE !?6,"COND"
- +1 WRITE !?6,"CODE",?14," CONDITION CODE DESCRIPTION"
- +2 WRITE !?6,"====",?14,"============================================================"
- +3 QUIT
- LOOP3 SET (ABMZ("LNUM"),ABMZ("NUM"),ABMZ(1))=0
- SET ABM=0
- FOR ABM("I")=1:1
- SET ABM=$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),53,ABM))
- IF 'ABM
- QUIT
- SET ABM("X")=ABM
- SET ABMZ("NUM")=ABM("I")
- DO COND1
- +1 IF +$ORDER(ABME(0))
- SET ABME("CONT")=""
- DO ^ABMDERR
- KILL ABME("CONT")
- +2 QUIT
- COND1 SET ABM("X0")=^ABMDCLM(DUZ(2),ABMP("CDFN"),53,ABM("X"),0)
- SET ABM("X")=$PIECE(^(0),U)
- +1 SET ABMZ(ABM("I"))=$EXTRACT(("00"_$PIECE(^ABMDCODE(ABM("X"),0),U)),$LENGTH($PIECE(^(0),U))+1,4)_U_ABM_U_$PIECE(ABM("X0"),U,2)
- +2 IF $Y>(IOSL-5)
- DO PAUSE^ABMDE1
- IF $DATA(DUOUT)!$DATA(DTOUT)!$DATA(DIROUT)
- GOTO XIT
- DO HD3
- +3 WRITE !,"[",ABM("I"),"]",?7,$PIECE(ABMZ(ABM("I")),U),?14,$PIECE(^ABMDCODE(ABM("X"),0),U,3)
- +4 QUIT
- +5 ;
- DISP4 ;EP - Entry Point for Value Codes
- +1 KILL ABMZ
- SET ABMZ("TITL")="VALUE CODES"
- SET ABMZ("PG")="9D"
- +2 IF $DATA(ABMP("DDL"))
- IF $Y>(IOSL-9)
- DO PAUSE^ABMDE1
- IF $DATA(DUOUT)!$DATA(DTOUT)!$DATA(DIROUT)
- GOTO XIT
- IF 1
- +3 IF '$TEST
- DO SUM^ABMDE1
- +4 ;
- VALU ; Value codes
- +1 SET ABMZ("SUB")=55
- +2 SET ABMZ("DR")=";W !;.02Amount OR Zip Code"
- +3 SET ABMZ("ITEM")="Value Code"
- +4 SET ABMZ("DIC")="^ABMDCODE("
- +5 SET ABMZ("X")="DINUM"
- +6 SET ABMZ("MAX")=4
- +7 DO HD4
- GOTO LOOP4
- HD4 WRITE !?6,"VALU"
- +1 WRITE !?6,"CODE",?14," VALUE CODE DESCRIPTION",?67,"AMOUNT"
- +2 WRITE !?6,"====",?14,"==================================================",?66,"========"
- +3 QUIT
- LOOP4 SET (ABMZ("LNUM"),ABMZ("NUM"),ABMZ(1))=0
- SET ABM=0
- FOR ABM("I")=1:1
- SET ABM=$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),55,ABM))
- IF 'ABM
- QUIT
- SET ABM("X")=ABM
- SET ABMZ("NUM")=ABM("I")
- DO VALU1
- +1 IF +$ORDER(ABME(0))
- SET ABME("CONT")=""
- DO ^ABMDERR
- KILL ABME("CONT")
- +2 QUIT
- VALU1 SET ABM("X0")=^ABMDCLM(DUZ(2),ABMP("CDFN"),55,ABM("X"),0)
- SET ABM("X")=$PIECE(^(0),U)
- +1 SET ABMZ(ABM("I"))=$EXTRACT(("00"_$PIECE(^ABMDCODE(ABM("X"),0),U)),$LENGTH($PIECE(^(0),U))+1,4)_U_ABM_U_$PIECE(ABM("X0"),U,2)
- +2 IF $Y>(IOSL-5)
- DO PAUSE^ABMDE1
- IF $DATA(DUOUT)!$DATA(DTOUT)!$DATA(DIROUT)
- GOTO XIT
- DO HD4
- +3 WRITE !,"[",ABM("I"),"]",?7,$PIECE(ABMZ(ABM("I")),U)
- +4 WRITE ?14,$PIECE(^ABMDCODE(ABM("X"),0),U,3)
- +5 ;W ?66,$S("A0^32"[$P(ABMZ(ABM("I")),U):$P(ABM("X0"),U,2),1:$J($P(ABM("X0"),U,2),8,2)) ;abm*2.6*11 HEAT89676
- +6 ;abm*2.6*11 HEAT89676
- WRITE ?66,$SELECT("A0^32^80^82^83"[$PIECE(ABMZ(ABM("I")),U):$PIECE(ABM("X0"),U,2),1:$JUSTIFY($PIECE(ABM("X0"),U,2),8,2))
- +7 QUIT
- +8 ;
- XIT QUIT
