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
