- ABMDE1A ; IHS/ASDST/DMJ - PAGE 1 - VIEW INFO ;
- ;;2.6;IHS Third Party Billing;**1,8**;NOV 12, 2009
- ;
- ; IHS/SD/SDR - abm*2.6*1 - HEAT4158 - added mammograpy cert#
- ;
- ; *********************************************************************
- ;
- V1 ; view
- S ABMZ("TITL")="IDENTIFIER - VIEW OPTION"
- S ABMZ("PG")=1
- D SUM^ABMDE1
- S ABMV=""
- S $P(ABMV,"-",80)=""
- W !,"Patient.: ",$P($P(ABMV("X2"),U),";",2)
- W ?48,"Sex.: ",$P(ABMV("X2"),U,2),?59,"DOB..: ",$P(ABMV("X2"),U,6)
- W !?10,$P(ABMV("X2"),U,3),?48,"Home Phone......: ",$P(ABMV("X2"),U,5)
- W !?10,$P(ABMV("X2"),U,4),?48,"Marital Status..: ",$P($P(ABMV("X2"),U,7),";",2)
- I $P(ABMV("X3"),U)="" G LOC
- W !!?3,"Employer...: ",$P(ABMV("X3"),U)
- W ?48,"Empl. Status..: ",$P($P(ABMV("X3"),U,5),";",2)
- W !?16,$P(ABMV("X3"),U,2)
- W ?48,"Work Phone....: ",$P(ABMV("X3"),U,4)
- W !?16,$P(ABMV("X3"),U,3)
- ;
- LOC ;
- W !,ABMV
- W !,"Facility: ",$P($P(ABMV("X1"),U),";",2)
- W ?48,"Tax Number..: ",$P(ABMV("X1"),U,6)
- W !?10,$P(ABMV("X1"),U,2)
- W ?48,"Phone.......: ",$P(ABMV("X1"),U,5)
- W !?10,$P(ABMV("X1"),U,3)
- W ?48,"NPI.........: "
- ;start old code abm*2.6*8
- ;S ABMLNPI=$S($P($G(^ABMNINS(ABMP("LDFN"),ABMP("INS"),1,ABMP("VTYP"),1)),U,8)'="":$P(^ABMNINS(ABMP("LDFN"),ABMP("INS"),1,ABMP("VTYP"),1),U,8),$P($G(^ABMDPARM(ABMP("LDFN"),1,2)),U,12)'="":$P(^ABMDPARM(ABMP("LDFN"),1,2),U,12),1:ABMP("LDFN"))
- ;W $S($P($$NPI^XUSNPI("Organization_ID",+ABMLNPI),U)>0:$P($$NPI^XUSNPI("Organization_ID",+ABMLNPI),U),1:"")
- ;end old start new code
- I $G(ABMP("INS"))'="" D
- .S ABMLNPI=$S($P($G(^ABMNINS(ABMP("LDFN"),ABMP("INS"),1,ABMP("VTYP"),1)),U,8)'="":$P(^ABMNINS(ABMP("LDFN"),ABMP("INS"),1,ABMP("VTYP"),1),U,8),$P($G(^ABMDPARM(ABMP("LDFN"),1,2)),U,12)'="":$P(^ABMDPARM(ABMP("LDFN"),1,2),U,12),1:ABMP("LDFN"))
- .W $S($P($$NPI^XUSNPI("Organization_ID",+ABMLNPI),U)>0:$P($$NPI^XUSNPI("Organization_ID",+ABMLNPI),U),1:"")
- ;end new code abm*2.6*8
- W !?10,$P(ABMV("X1"),U,4)
- W ?48,"ASUFAC......: ",$$ASUFAC^ABMUCUTL($P(ABMV("X1"),";"),ABMP("VDT"))
- W !?48,"Mammo Cert#.: ",$P($G(^ABMDPARM(ABMP("LDFN"),1,5)),U,4) ;abm*2.6*1 HEAT4158
- D ^ABMDERR
- W !
- S ABM("Y")=+Y
- ;
- XIT ;
- Q
- ABMDE1A ; IHS/ASDST/DMJ - PAGE 1 - VIEW INFO ;
- +1 ;;2.6;IHS Third Party Billing;**1,8**;NOV 12, 2009
- +2 ;
- +3 ; IHS/SD/SDR - abm*2.6*1 - HEAT4158 - added mammograpy cert#
- +4 ;
- +5 ; *********************************************************************
- +6 ;
- V1 ; view
- +1 SET ABMZ("TITL")="IDENTIFIER - VIEW OPTION"
- +2 SET ABMZ("PG")=1
- +3 DO SUM^ABMDE1
- +4 SET ABMV=""
- +5 SET $PIECE(ABMV,"-",80)=""
- +6 WRITE !,"Patient.: ",$PIECE($PIECE(ABMV("X2"),U),";",2)
- +7 WRITE ?48,"Sex.: ",$PIECE(ABMV("X2"),U,2),?59,"DOB..: ",$PIECE(ABMV("X2"),U,6)
- +8 WRITE !?10,$PIECE(ABMV("X2"),U,3),?48,"Home Phone......: ",$PIECE(ABMV("X2"),U,5)
- +9 WRITE !?10,$PIECE(ABMV("X2"),U,4),?48,"Marital Status..: ",$PIECE($PIECE(ABMV("X2"),U,7),";",2)
- +10 IF $PIECE(ABMV("X3"),U)=""
- GOTO LOC
- +11 WRITE !!?3,"Employer...: ",$PIECE(ABMV("X3"),U)
- +12 WRITE ?48,"Empl. Status..: ",$PIECE($PIECE(ABMV("X3"),U,5),";",2)
- +13 WRITE !?16,$PIECE(ABMV("X3"),U,2)
- +14 WRITE ?48,"Work Phone....: ",$PIECE(ABMV("X3"),U,4)
- +15 WRITE !?16,$PIECE(ABMV("X3"),U,3)
- +16 ;
- LOC ;
- +1 WRITE !,ABMV
- +2 WRITE !,"Facility: ",$PIECE($PIECE(ABMV("X1"),U),";",2)
- +3 WRITE ?48,"Tax Number..: ",$PIECE(ABMV("X1"),U,6)
- +4 WRITE !?10,$PIECE(ABMV("X1"),U,2)
- +5 WRITE ?48,"Phone.......: ",$PIECE(ABMV("X1"),U,5)
- +6 WRITE !?10,$PIECE(ABMV("X1"),U,3)
- +7 WRITE ?48,"NPI.........: "
- +8 ;start old code abm*2.6*8
- +9 ;S ABMLNPI=$S($P($G(^ABMNINS(ABMP("LDFN"),ABMP("INS"),1,ABMP("VTYP"),1)),U,8)'="":$P(^ABMNINS(ABMP("LDFN"),ABMP("INS"),1,ABMP("VTYP"),1),U,8),$P($G(^ABMDPARM(ABMP("LDFN"),1,2)),U,12)'="":$P(^ABMDPARM(ABMP("LDFN"),1,2),U,12),1:ABMP("LDFN"))
- +10 ;W $S($P($$NPI^XUSNPI("Organization_ID",+ABMLNPI),U)>0:$P($$NPI^XUSNPI("Organization_ID",+ABMLNPI),U),1:"")
- +11 ;end old start new code
- +12 IF $GET(ABMP("INS"))'=""
- Begin DoDot:1
- +13 SET ABMLNPI=$SELECT($PIECE($GET(^ABMNINS(ABMP("LDFN"),ABMP("INS"),1,ABMP("VTYP"),1)),U,8)'="":...
- ... $PIECE(^ABMNINS(ABMP("LDFN"),ABMP("INS"),1,ABMP("VTYP"),1),U,8),$PIECE($GET(^ABMDPARM(ABMP("LDFN"),1,2)),U,12)'="":$PIECE(^ABMDPARM(ABMP("LDFN"),1,2),U,12),1:ABMP("LDFN"))
- +14 WRITE $SELECT($PIECE($$NPI^XUSNPI("Organization_ID",+ABMLNPI),U)>0:$PIECE($$NPI^XUSNPI("Organization_ID",+ABMLNPI),U),1:"")
- End DoDot:1
- +15 ;end new code abm*2.6*8
- +16 WRITE !?10,$PIECE(ABMV("X1"),U,4)
- +17 WRITE ?48,"ASUFAC......: ",$$ASUFAC^ABMUCUTL($PIECE(ABMV("X1"),";"),ABMP("VDT"))
- +18 ;abm*2.6*1 HEAT4158
- WRITE !?48,"Mammo Cert#.: ",$PIECE($GET(^ABMDPARM(ABMP("LDFN"),1,5)),U,4)
- +19 DO ^ABMDERR
- +20 WRITE !
- +21 SET ABM("Y")=+Y
- +22 ;
- XIT ;
- +1 QUIT
