- ABMDE7A ; IHS/ASDST/DMJ - Edit Page 7 - Inpatient Display Screen ;
- ;;2.6;IHS Third Party Billing System;**2,14**;NOV 12, 2009;Build 238
- ;
- ; IHS/SD/SDR - v2.5 p8 - IM14016/IM15234/IM15615
- ; Fix to Prior Authorization field
- ;
- ; IHS/SD/SDR - v2.6 CSV
- ; IHS/SD/SDR - abm*2.6*2 - NO HEAT - Fix for <UNDEF>ICDDX+1^ABMCVAPI
- ;IHS/SD/SDR - 2.6*14 - Added '+' to DX^ABMCVAPI call to ensure numeric
- ;
- DISP ;EP - Entry Point for displaying Inpatient info
- S ABMZ("TITL")="INPATIENT DATA",ABMZ("PG")=7
- I $D(ABMP("DDL")),$Y>(IOSL-9) D PAUSE^ABMDE1 Q:$D(DUOUT)!$D(DTOUT)!$D(DIROUT) I 1
- E D SUM^ABMDE1
- ;
- CNODES S ABM("C5")=$G(^ABMDCLM(DUZ(2),ABMP("CDFN"),5)),ABM("C6")=$G(^ABMDCLM(DUZ(2),ABMP("CDFN"),6)),ABM("C7")=$G(^ABMDCLM(DUZ(2),ABMP("CDFN"),7))
- ;
- ; Hosp Info
- ADMIT W !,"[1] Admission Date...: ",$$HDT^ABMDUTL($P(ABM("C6"),U,1))
- AHR W ?40,"[2] Admission Hour....: ",$P(ABM("C6"),U,2)
- I $Y>(IOSL-6) D PAUSE^ABMDE1 Q:$D(DUOUT)!$D(DTOUT)!$D(DIROUT)
- TYPE W !,"[3] Admission Type...: " S ABM(1)=$P(ABM("C5"),U,1) I ABM(1)]"" S ABM(1)=$E($P(^ABMDCODE(ABM(1),0),U,3),1,49) W $E((100+$P(^(0),U,1)),2,3)," (",ABM(1),")"
- I $P(ABM("C5"),U,10) W ?40,"[3a] Newborn Days...: ",$P(ABM("C5"),U,10)
- SRC W !,"[4] Admission Source.: " S ABM(1)=$P(ABM("C5"),U,2) I ABM(1)]"" S ABM(1)=$E($P(^ABMDCODE(ABM(1),0),U,3),1,49) W $E((100+$P(^(0),U,1)),2,3)," (",ABM(1),")"
- DX ;W !,"[5] Admitting Diag...: " S ABM(1)=$P(ABM("C5"),U,9) I ABM(1)]"",$D(^ICD9(ABM(1),0)) S ABM(1)=$P($$DX^ABMCVAPI(ABM(1),ABMP("VDT")),U,2) W ABM(1)," (",$E($$ICDDX^ABMCVAPI(ABM(1),ABMP("VDT")),1,49),")" ;CSV-c ;abm*2.6*2 NOHEAT
- ;W !,"[5] Admitting Diag...: " S ABM(1)=$P(ABM("C5"),U,9) I ABM(1)]"",$D(^ICD9(ABM(1),0)) S ABM(1)=$P($$DX^ABMCVAPI(ABM(1),ABMP("VDT")),U,2) W ABM(1)," (",$E($P($$DX^ABMCVAPI(ABM(1),ABMP("VDT")),U,4),1,49),")" ;CSV-c ;abm*2.6*2 NOHEAT ;abm*2.6*14
- W !,"[5] Admitting Diag...: " S ABM(1)=$P(ABM("C5"),U,9) I ABM(1)]"",$D(^ICD9(ABM(1),0)) S ABM(1)=$P($$DX^ABMCVAPI(+ABM(1),ABMP("VDT")),U,2) W ABM(1)," (",$E($P($$DX^ABMCVAPI(ABM(1),ABMP("VDT")),U,4),1,49),")" ;CSV-c ;abm*2.6*14 +'d IEN
- I $Y>(IOSL-6) D PAUSE^ABMDE1 Q:$D(DUOUT)!$D(DTOUT)!$D(DIROUT)
- DISCH W !!,"[6] Discharge Date...: ",$$HDT^ABMDUTL($P(ABM("C6"),U,3))
- DHR W ?40,"[7] Discharge Hour....: ",$P(ABM("C6"),U,4)
- STAT W !,"[8] Discharge Status.: " S ABM(1)=$P(ABM("C5"),U,3) I ABM(1)]"" S ABM(1)=$P(^ABMDCODE(ABM(1),0),U,3) W $E((100+$P(^(0),U,1)),2,3)," (",ABM(1),")"
- I $Y>(IOSL-6) D PAUSE^ABMDE1 Q:$D(DUOUT)!$D(DTOUT)!$D(DIROUT)
- FROM W !,"[9] Service From Date: ",$$HDT^ABMDUTL($P(ABM("C7"),U,1))
- THRU W ?40,"[10] Service Thru Date: ",$$HDT^ABMDUTL($P(ABM("C7"),U,2))
- I $Y>(IOSL-6) D PAUSE^ABMDE1 Q:$D(DUOUT)!$D(DTOUT)!$D(DIROUT)
- CVD W !,"[11] Covered Days...: ",$P(ABM("C7"),U,3)
- NONCOVD W ?40,"[12] Non-Cvd Days...: ",$P(ABM("C6"),U,6)
- AUTH W !,"[13] Prior Auth Number.....: ",$P(ABM("C5"),U,12)
- PCOMP D
- .Q:'$D(ABMP("VTYP",999))
- .Q:'$D(ABMP("FLAT"))
- .W !,"[14] Prof Comp Days..: ",$P(ABM("C5"),U,7)
- Q
- ;
- ;
- V1 ;EP - Entry Point for Inpatient View Command
- S ABMZ("TITL")="PAGE 7 - VIEW OPTION" D SUM^ABMDE1
- D ^ABMDERR
- Q
- ABMDE7A ; IHS/ASDST/DMJ - Edit Page 7 - Inpatient Display Screen ;
- +1 ;;2.6;IHS Third Party Billing System;**2,14**;NOV 12, 2009;Build 238
- +2 ;
- +3 ; IHS/SD/SDR - v2.5 p8 - IM14016/IM15234/IM15615
- +4 ; Fix to Prior Authorization field
- +5 ;
- +6 ; IHS/SD/SDR - v2.6 CSV
- +7 ; IHS/SD/SDR - abm*2.6*2 - NO HEAT - Fix for <UNDEF>ICDDX+1^ABMCVAPI
- +8 ;IHS/SD/SDR - 2.6*14 - Added '+' to DX^ABMCVAPI call to ensure numeric
- +9 ;
- DISP ;EP - Entry Point for displaying Inpatient info
- +1 SET ABMZ("TITL")="INPATIENT DATA"
- SET ABMZ("PG")=7
- +2 IF $DATA(ABMP("DDL"))
- IF $Y>(IOSL-9)
- DO PAUSE^ABMDE1
- IF $DATA(DUOUT)!$DATA(DTOUT)!$DATA(DIROUT)
- QUIT
- IF 1
- +3 IF '$TEST
- DO SUM^ABMDE1
- +4 ;
- CNODES SET ABM("C5")=$GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),5))
- SET ABM("C6")=$GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),6))
- SET ABM("C7")=$GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),7))
- +1 ;
- +2 ; Hosp Info
- ADMIT WRITE !,"[1] Admission Date...: ",$$HDT^ABMDUTL($PIECE(ABM("C6"),U,1))
- AHR WRITE ?40,"[2] Admission Hour....: ",$PIECE(ABM("C6"),U,2)
- +1 IF $Y>(IOSL-6)
- DO PAUSE^ABMDE1
- IF $DATA(DUOUT)!$DATA(DTOUT)!$DATA(DIROUT)
- QUIT
- TYPE WRITE !,"[3] Admission Type...: "
- SET ABM(1)=$PIECE(ABM("C5"),U,1)
- IF ABM(1)]""
- SET ABM(1)=$EXTRACT($PIECE(^ABMDCODE(ABM(1),0),U,3),1,49)
- WRITE $EXTRACT((100+$PIECE(^(0),U,1)),2,3)," (",ABM(1),")"
- +1 IF $PIECE(ABM("C5"),U,10)
- WRITE ?40,"[3a] Newborn Days...: ",$PIECE(ABM("C5"),U,10)
- SRC WRITE !,"[4] Admission Source.: "
- SET ABM(1)=$PIECE(ABM("C5"),U,2)
- IF ABM(1)]""
- SET ABM(1)=$EXTRACT($PIECE(^ABMDCODE(ABM(1),0),U,3),1,49)
- WRITE $EXTRACT((100+$PIECE(^(0),U,1)),2,3)," (",ABM(1),")"
- DX ;W !,"[5] Admitting Diag...: " S ABM(1)=$P(ABM("C5"),U,9) I ABM(1)]"",$D(^ICD9(ABM(1),0)) S ABM(1)=$P($$DX^ABMCVAPI(ABM(1),ABMP("VDT")),U,2) W ABM(1)," (",$E($$ICDDX^ABMCVAPI(ABM(1),ABMP("VDT")),1,49),")" ;CSV-c ;abm*2.6*2 NOHEAT
- +1 ;W !,"[5] Admitting Diag...: " S ABM(1)=$P(ABM("C5"),U,9) I ABM(1)]"",$D(^ICD9(ABM(1),0)) S ABM(1)=$P($$DX^ABMCVAPI(ABM(1),ABMP("VDT")),U,2) W ABM(1)," (",$E($P($$DX^ABMCVAPI(ABM(1),ABMP("VDT")),U,4),1,49),")" ;CSV-c ;abm*2.6*2 NOHEAT ;abm*2.
- 6*14
- +2 ;CSV-c ;abm*2.6*14 +'d IEN
- WRITE !,"[5] Admitting Diag...: "
- SET ABM(1)=$PIECE(ABM("C5"),U,9)
- IF ABM(1)]""
- IF $DATA(^ICD9(ABM(1),0))
- SET ABM(1)=$PIECE($$DX^ABMCVAPI(+ABM(1),ABMP("VDT")),U,2)
- WRITE ABM(1)," (",$EXTRACT($PIECE($$DX^ABMCVAPI(ABM(1),ABMP("VDT")),U,4),1,49),")"
- +3 IF $Y>(IOSL-6)
- DO PAUSE^ABMDE1
- IF $DATA(DUOUT)!$DATA(DTOUT)!$DATA(DIROUT)
- QUIT
- DISCH WRITE !!,"[6] Discharge Date...: ",$$HDT^ABMDUTL($PIECE(ABM("C6"),U,3))
- DHR WRITE ?40,"[7] Discharge Hour....: ",$PIECE(ABM("C6"),U,4)
- STAT WRITE !,"[8] Discharge Status.: "
- SET ABM(1)=$PIECE(ABM("C5"),U,3)
- IF ABM(1)]""
- SET ABM(1)=$PIECE(^ABMDCODE(ABM(1),0),U,3)
- WRITE $EXTRACT((100+$PIECE(^(0),U,1)),2,3)," (",ABM(1),")"
- +1 IF $Y>(IOSL-6)
- DO PAUSE^ABMDE1
- IF $DATA(DUOUT)!$DATA(DTOUT)!$DATA(DIROUT)
- QUIT
- FROM WRITE !,"[9] Service From Date: ",$$HDT^ABMDUTL($PIECE(ABM("C7"),U,1))
- THRU WRITE ?40,"[10] Service Thru Date: ",$$HDT^ABMDUTL($PIECE(ABM("C7"),U,2))
- +1 IF $Y>(IOSL-6)
- DO PAUSE^ABMDE1
- IF $DATA(DUOUT)!$DATA(DTOUT)!$DATA(DIROUT)
- QUIT
- CVD WRITE !,"[11] Covered Days...: ",$PIECE(ABM("C7"),U,3)
- NONCOVD WRITE ?40,"[12] Non-Cvd Days...: ",$PIECE(ABM("C6"),U,6)
- AUTH WRITE !,"[13] Prior Auth Number.....: ",$PIECE(ABM("C5"),U,12)
- PCOMP Begin DoDot:1
- +1 IF '$DATA(ABMP("VTYP",999))
- QUIT
- +2 IF '$DATA(ABMP("FLAT"))
- QUIT
- +3 WRITE !,"[14] Prof Comp Days..: ",$PIECE(ABM("C5"),U,7)
- End DoDot:1
- +4 QUIT
- +5 ;
- +6 ;
- V1 ;EP - Entry Point for Inpatient View Command
- +1 SET ABMZ("TITL")="PAGE 7 - VIEW OPTION"
- DO SUM^ABMDE1
- +2 DO ^ABMDERR
- +3 QUIT
