- ABMDE9C ; IHS/ASDST/DMJ - Edit Page 9 - UB-82 CODES ;
- ;;2.6;IHS 3P BILLING SYSTEM;**11,14**;NOV 12, 2009;Build 238
- ;
- ; IHS/SD/SDR - v2.5 p8 - IM13796 - <UNDEF>LOOP^ABMDE9C
- ;IHS/SD/SDR - 2.6*14 - HEAT163734 - corrected misspelling
- ;
- DISP ;EP - Entry Point for Occurance Codes
- K ABMZ S ABMZ("TITL")="OCCURRENCE CODES",ABMZ("PG")="9A"
- 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 HD ;abm*2.6*11 HEAT87226
- ;
- OCCR ; Occurance codes
- ;S ABMZ("SUB")=51,ABMZ("DR")=";W !;.02",ABMZ("ITEM")="Occurance Code",ABMZ("DIC")="^ABMDCODE(",ABMZ("X")="DINUM",ABMZ("MAX")=5 ;abm*2.6*14 HEAT163734
- S ABMZ("SUB")=51,ABMZ("DR")=";W !;.02",ABMZ("ITEM")="Occurrence Code",ABMZ("DIC")="^ABMDCODE(",ABMZ("X")="DINUM",ABMZ("MAX")=5 ;abm*2.6*14 HEAT163734
- ;G LOOP ;abm*2.6*11 HEAT87226
- D HD G LOOP ;abm*2.6*11 HEAT87226
- HD W !?6,"OCCR"
- W !?6,"CODE",?14," OCCURRENCE DESCRIPTION",?68,"DATE"
- W !?6,"====",?14,"==================================================",?66,"========"
- Q
- LOOP ;
- S (ABMZ("LNUM"),ABMZ("NUM"),ABMZ(1),ABM)=0 F ABM("I")=1:1 S ABM=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),51,ABM)) Q:'ABM!$D(DIRUT) S ABM("X")=ABM,ABMZ("NUM")=ABM("I") D OCCR1
- I +$O(ABME(0)) S ABME("CONT")="" D ^ABMDERR K ABME("CONT")
- Q
- OCCR1 ;
- ;I $D(DIROUT)!$D(DUOUT)!$D(DTOUT)!$D(DIRUT) G XIT ;abm*2.6*11 HEAT87226
- S ABM("X0")=^ABMDCLM(DUZ(2),ABMP("CDFN"),51,ABM("X"),0),ABM("X")=$P(^(0),U)
- ;S ABMZ(ABM("I"))=$E(($P(^ABMDCODE(ABM("X"),0),U)+100),2,3)_U_ABM_U_$P(ABM("X0"),U,2) ;abm*2.6*11
- S ABMZ(ABM("I"))=$P(^ABMDCODE(ABM("X"),0),U)_U_ABM_U_$P(ABM("X0"),U,2) ;abm*2.6*11
- ;I $Y>(IOSL-5) D PAUSE^ABMDE1 Q:$D(DUOUT)!$D(DTOUT)!$D(DIROUT)!$D(DIRUT) D HD ;abm*2.6*11 HEAT87226
- I $Y>(IOSL-5) D PAUSE^ABMDE1 G:$D(DUOUT)!$D(DTOUT)!$D(DIROUT)!$D(DIRUT) XIT D HD ;abm*2.6*11 HEAT87226
- W !,"[",ABM("I"),"]",?7,$P(ABMZ(ABM("I")),U),?14,$P(^ABMDCODE(ABM("X"),0),U,3),?66 S ABM("DT")=$P(ABM("X0"),U,2) D DT W ABM("DT")
- Q
- ;
- DISP2 ;EP - Entry Point for Occurance Span Codes
- K ABMZ S ABMZ("TITL")="OCCURRENCE SPAN CODES",ABMZ("PG")="9B"
- I $D(ABMP("DDL")),$Y>(IOSL-9) D PAUSE^ABMDE1 G:$D(DUOUT)!$D(DTOUT)!$D(DIROUT) XIT I 1
- E D SUM^ABMDE1
- ;
- SPAN ; Occurrence Span codes
- S ABMZ("SUB")=57,ABMZ("DR")=";W !;.02;W !;.03",ABMZ("ITEM")="Occurrence Span",ABMZ("DIC")="^ABMDCODE(",ABMZ("X")="X",ABMZ("MAX")=2
- D HD2 G LOOP2
- HD2 W !?6,"SPAN"
- W !?6,"CODE",?14," OCCURRENCE SPAN DESCRIPTION",?58,"FROM",?69,"TO"
- W !?6,"====",?14,"========================================",?56,"========",?66,"========"
- Q
- LOOP2 S (ABMZ("LNUM"),ABMZ("NUM"),ABMZ(1))=0,ABM=0 F ABM("I")=1:1 S ABM=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),57,ABM)) Q:'ABM S ABM("X")=ABM,ABMZ("NUM")=ABM("I") D SPAN1
- I +$O(ABME(0)) S ABME("CONT")="" D ^ABMDERR K ABME("CONT")
- Q
- ;
- SPAN1 S ABM("X0")=^ABMDCLM(DUZ(2),ABMP("CDFN"),57,ABM("X"),0),ABM("X")=$P(^(0),U)
- ;S ABMZ(ABM("I"))=$E((100+$P(^ABMDCODE(ABM("X"),0),U)),2,3)_U_ABM_U_$P(ABM("X0"),U,2) ;abm*2.6*11
- S ABMZ(ABM("I"))=$P(^ABMDCODE(ABM("X"),0),U)_U_ABM_U_$P(ABM("X0"),U,2) ;abm*2.6*11
- I $Y>(IOSL-8) D PAUSE^ABMDE1 G:$D(DUOUT)!$D(DTOUT)!$D(DIROUT) XIT D HD2
- W !,"[",ABM("I"),"]",?7,$P(ABMZ(ABM("I")),U),?14,$P(^ABMDCODE(ABM("X"),0),U,3),?56 S ABM("DT")=$P(ABM("X0"),U,2) D DT W ABM("DT") S ABM("DT")=$P(ABM("X0"),U,3) D DT W ?66,ABM("DT")
- Q
- ;
- XIT K ABM,ABMZ
- Q
- ;
- DT ;date conversion
- I ABM("DT")]"" S ABM("DT")=$$HDT^ABMDUTL(ABM("DT"))
- Q
- ABMDE9C ; IHS/ASDST/DMJ - Edit Page 9 - UB-82 CODES ;
- +1 ;;2.6;IHS 3P BILLING SYSTEM;**11,14**;NOV 12, 2009;Build 238
- +2 ;
- +3 ; IHS/SD/SDR - v2.5 p8 - IM13796 - <UNDEF>LOOP^ABMDE9C
- +4 ;IHS/SD/SDR - 2.6*14 - HEAT163734 - corrected misspelling
- +5 ;
- DISP ;EP - Entry Point for Occurance Codes
- +1 KILL ABMZ
- SET ABMZ("TITL")="OCCURRENCE CODES"
- SET ABMZ("PG")="9A"
- +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 ;D HD ;abm*2.6*11 HEAT87226
- +5 ;
- OCCR ; Occurance codes
- +1 ;S ABMZ("SUB")=51,ABMZ("DR")=";W !;.02",ABMZ("ITEM")="Occurance Code",ABMZ("DIC")="^ABMDCODE(",ABMZ("X")="DINUM",ABMZ("MAX")=5 ;abm*2.6*14 HEAT163734
- +2 ;abm*2.6*14 HEAT163734
- SET ABMZ("SUB")=51
- SET ABMZ("DR")=";W !;.02"
- SET ABMZ("ITEM")="Occurrence Code"
- SET ABMZ("DIC")="^ABMDCODE("
- SET ABMZ("X")="DINUM"
- SET ABMZ("MAX")=5
- +3 ;G LOOP ;abm*2.6*11 HEAT87226
- +4 ;abm*2.6*11 HEAT87226
- DO HD
- GOTO LOOP
- HD WRITE !?6,"OCCR"
- +1 WRITE !?6,"CODE",?14," OCCURRENCE DESCRIPTION",?68,"DATE"
- +2 WRITE !?6,"====",?14,"==================================================",?66,"========"
- +3 QUIT
- LOOP ;
- +1 SET (ABMZ("LNUM"),ABMZ("NUM"),ABMZ(1),ABM)=0
- FOR ABM("I")=1:1
- SET ABM=$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),51,ABM))
- IF 'ABM!$DATA(DIRUT)
- QUIT
- SET ABM("X")=ABM
- SET ABMZ("NUM")=ABM("I")
- DO OCCR1
- +2 IF +$ORDER(ABME(0))
- SET ABME("CONT")=""
- DO ^ABMDERR
- KILL ABME("CONT")
- +3 QUIT
- OCCR1 ;
- +1 ;I $D(DIROUT)!$D(DUOUT)!$D(DTOUT)!$D(DIRUT) G XIT ;abm*2.6*11 HEAT87226
- +2 SET ABM("X0")=^ABMDCLM(DUZ(2),ABMP("CDFN"),51,ABM("X"),0)
- SET ABM("X")=$PIECE(^(0),U)
- +3 ;S ABMZ(ABM("I"))=$E(($P(^ABMDCODE(ABM("X"),0),U)+100),2,3)_U_ABM_U_$P(ABM("X0"),U,2) ;abm*2.6*11
- +4 ;abm*2.6*11
- SET ABMZ(ABM("I"))=$PIECE(^ABMDCODE(ABM("X"),0),U)_U_ABM_U_$PIECE(ABM("X0"),U,2)
- +5 ;I $Y>(IOSL-5) D PAUSE^ABMDE1 Q:$D(DUOUT)!$D(DTOUT)!$D(DIROUT)!$D(DIRUT) D HD ;abm*2.6*11 HEAT87226
- +6 ;abm*2.6*11 HEAT87226
- IF $Y>(IOSL-5)
- DO PAUSE^ABMDE1
- IF $DATA(DUOUT)!$DATA(DTOUT)!$DATA(DIROUT)!$DATA(DIRUT)
- GOTO XIT
- DO HD
- +7 WRITE !,"[",ABM("I"),"]",?7,$PIECE(ABMZ(ABM("I")),U),?14,$PIECE(^ABMDCODE(ABM("X"),0),U,3),?66
- SET ABM("DT")=$PIECE(ABM("X0"),U,2)
- DO DT
- WRITE ABM("DT")
- +8 QUIT
- +9 ;
- DISP2 ;EP - Entry Point for Occurance Span Codes
- +1 KILL ABMZ
- SET ABMZ("TITL")="OCCURRENCE SPAN CODES"
- SET ABMZ("PG")="9B"
- +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 ;
- SPAN ; Occurrence Span codes
- +1 SET ABMZ("SUB")=57
- SET ABMZ("DR")=";W !;.02;W !;.03"
- SET ABMZ("ITEM")="Occurrence Span"
- SET ABMZ("DIC")="^ABMDCODE("
- SET ABMZ("X")="X"
- SET ABMZ("MAX")=2
- +2 DO HD2
- GOTO LOOP2
- HD2 WRITE !?6,"SPAN"
- +1 WRITE !?6,"CODE",?14," OCCURRENCE SPAN DESCRIPTION",?58,"FROM",?69,"TO"
- +2 WRITE !?6,"====",?14,"========================================",?56,"========",?66,"========"
- +3 QUIT
- LOOP2 SET (ABMZ("LNUM"),ABMZ("NUM"),ABMZ(1))=0
- SET ABM=0
- FOR ABM("I")=1:1
- SET ABM=$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),57,ABM))
- IF 'ABM
- QUIT
- SET ABM("X")=ABM
- SET ABMZ("NUM")=ABM("I")
- DO SPAN1
- +1 IF +$ORDER(ABME(0))
- SET ABME("CONT")=""
- DO ^ABMDERR
- KILL ABME("CONT")
- +2 QUIT
- +3 ;
- SPAN1 SET ABM("X0")=^ABMDCLM(DUZ(2),ABMP("CDFN"),57,ABM("X"),0)
- SET ABM("X")=$PIECE(^(0),U)
- +1 ;S ABMZ(ABM("I"))=$E((100+$P(^ABMDCODE(ABM("X"),0),U)),2,3)_U_ABM_U_$P(ABM("X0"),U,2) ;abm*2.6*11
- +2 ;abm*2.6*11
- SET ABMZ(ABM("I"))=$PIECE(^ABMDCODE(ABM("X"),0),U)_U_ABM_U_$PIECE(ABM("X0"),U,2)
- +3 IF $Y>(IOSL-8)
- DO PAUSE^ABMDE1
- IF $DATA(DUOUT)!$DATA(DTOUT)!$DATA(DIROUT)
- GOTO XIT
- DO HD2
- +4 WRITE !,"[",ABM("I"),"]",?7,$PIECE(ABMZ(ABM("I")),U),?14,$PIECE(^ABMDCODE(ABM("X"),0),U,3),?56
- SET ABM("DT")=$PIECE(ABM("X0"),U,2)
- DO DT
- WRITE ABM("DT")
- SET ABM("DT")=$PIECE(ABM("X0"),U,3)
- DO DT
- WRITE ?66,ABM("DT")
- +5 QUIT
- +6 ;
- XIT KILL ABM,ABMZ
- +1 QUIT
- +2 ;
- DT ;date conversion
- +1 IF ABM("DT")]""
- SET ABM("DT")=$$HDT^ABMDUTL(ABM("DT"))
- +2 QUIT
