Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ABMDE4

ABMDE4.m

Go to the documentation of this file. 
  1. ABMDE4 ; IHS/ASDST/DMJ - Edit Page 4 - Providers ;  
  1.  ;;2.6;IHS Third Party Billing;**1,3,9,11**;NOV 12, 2009;Build 133
  1.  ;
  1.  ; IHS/SD/SDR - v2.5 p9 - task 1
  1.  ;    Only allows providers on page 4
  1.  ;
  1.  ; IHS/SD/SDR - v2.5 p10 - IM20059
  1.  ;   All providers displayed instead of one for each type
  1.  ;
  1.  ; IHS/SD/SDR - v2.5 p11 - NPI
  1.  ; IHS/SD/SDR - abm*2.6*1 - HEAT4207 - If subpart NPI is populated show it
  1.  ;   on page4
  1.  ; IHS/SD/SDR - abm*2.6*3 HEAT12442 - Make error 92 display for all 837s
  1.  ;
  1.  Q:$D(ABMP("WORKSHEET"))
  1.  K ABM,ABME,ABMZ
  1. OPT K ABME D DISP G XIT:$D(DTOUT)!$D(DUOUT)!$D(DIROUT)
  1.  W !! S ABMP("OPT")="ADVNJBQ" S:ABM("NUM")=0 ABMP("ED")=1 D SEL^ABMDEOPT K ABMP("ED") I "AVD"'[$E(Y) G XIT
  1.  G XIT:$D(DTOUT)!$D(DUOUT)!$D(DIROUT)
  1.  S ABM("DO")=$S($E(Y)="A":"A1",$E(Y)="V":"^ABMDE4A",1:"D1") D @ABM("DO")
  1.  G OPT
  1.  ;
  1. DISP S ABMZ("TITL")="PROVIDER DATA",ABMZ("PG")=4
  1.  I $D(ABMP("DDL")),$Y>(IOSL-9) D PAUSE^ABMDE1 Q:$D(DUOUT)!$D(DTOUT)!$D(DIROUT)  I 1 G PROV
  1.  D SUM^ABMDE1
  1.  ;
  1. PROV ; Provider Info
  1.  K ABM("A"),ABM("O")
  1.  S ABM("SUB")=41
  1.  S ABM("DR")=";.03"
  1.  S ABM("ITEM")="Provider"
  1.  S ABM("DIC")="^VA(200,"
  1.  S ABM("PRIM")=""
  1.  S ABM("MD")=0
  1.  S ABMNPIUS=$$NPIUSAGE^ABMUTLF(ABMP("LDFN"),ABMP("INS"))
  1.  I ABMNPIUS=""!(ABMNPIUS="L") D
  1.  .W !?17,"PROVIDER",?39,"NUMBER",?59,"DISCIPLINE"
  1.  .W !?8,"==========================",?36,"============",?50,"============================="
  1.  I ABMNPIUS="N" D
  1.  .W !?17,"PROVIDER",?40,"NPI",?59,"DISCIPLINE"
  1.  .W !?8,"==========================",?36,"============",?50,"============================="
  1.  I ABMNPIUS="B" D
  1.  .W !?15,"PROVIDER",?34,"NPI",?45,"NUMBER",?62,"DISCIPLINE"
  1.  .W !?8,"=====================",?30,"==========",?42,"===========",?55,"======================="
  1.  S ABM("NUM")=0,ABM=""
  1.  S ABM("I")=1
  1.  F  S ABM=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),41,"C",ABM)) Q:ABM=""  D
  1.  .S ABM("X")=""
  1.  .F  S ABM("X")=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),41,"C",ABM,ABM("X"))) Q:ABM("X")=""  D
  1.  ..S ABM("NUM")=ABM("I") D PRV
  1.  .S ABM("I")=ABM("I")+1
  1.  I $P(^ABMDEXP(ABMP("EXP"),0),U)["HCFA-1500",ABMP("EXP")'=15,$P(^ABMDPARM(DUZ(2),1,0),U,17)=2 Q
  1.  I +$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),41,"B",0))=0 S ABME(244)=""  ;abm*2.6*11 HEAT81017
  1.  I '$D(ABM("A")) D
  1.  .;Q:ABMP("EXP")=22  ;abm*2.6*3 HEAT12442
  1.  .;Q:ABMP("EXP")=23  ;abm*2.6*3 HEAT12442
  1.  .Q:ABMP("EXP")=22!(ABMP("EXP")=32)  ;abm*2.6*9 HEAT57734
  1.  .S ABME(92)=""
  1.  I '$D(^ABMDCLM(DUZ(2),ABMP("CDFN"),41,"C","O")),$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),19,0)),ABMP("PAGE")'[8 S ABME(2)=""
  1. ER I +$O(ABME(0)) S ABME("CONT")="" D ^ABMDERR K ABME("CONT")
  1.  Q
  1. PRV ;provider display
  1.  S ABMTYP("A")="(attn)"
  1.  S ABMTYP("O")="(oper)"
  1.  S ABMTYP("T")="(other)"
  1.  S ABMTYP("F")="(refer)"
  1.  S ABMTYP("R")="(rend)"
  1.  S ABMTYP("P")="(pursvc)"
  1.  S ABMTYP("S")="(suprvs)"
  1.  D SEL^ABMDE4X,AFFL^ABMDE4X
  1.  I ABMNPIUS=""!(ABMNPIUS="L") D
  1.  .W !,ABMTYP($P(ABM("X0"),U,2))
  1.  .I $D(ABM($P(ABM("X0"),U,2))) W ?8,$P(ABM($P(ABM("X0"),U,2)),U),?36,ABM("PNUM"),?50,ABM("DISC")
  1.  ;
  1.  I ABMNPIUS="N" D
  1.  .W !,ABMTYP($P(ABM("X0"),U,2))
  1.  .I $D(ABM($P(ABM("X0"),U,2))) D
  1.  ..W ?8,$P(ABM($P(ABM("X0"),U,2)),U)
  1.  ..;W ?36,$S($P($$NPI^XUSNPI("Individual_ID",+ABM("X0")),U)>0:$P($$NPI^XUSNPI("Individual_ID",+ABM("X0")),U),$P($$NPI^XUSNPI("Organization_ID",+ABMP("LDFN")),U)>0:$P($$NPI^XUSNPI("Organization_ID",+ABMP("LDFN")),U)_"*",1:"")  ;abm*2.6*1 HEAT4207
  1.  ..;start new code abm*2.6*1 HEAT4207
  1.  ..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"))
  1.  ..W ?36,$S($P($$NPI^XUSNPI("Individual_ID",+ABM("X0")),U)>0:$P($$NPI^XUSNPI("Individual_ID",+ABM("X0")),U),$P($$NPI^XUSNPI("Organization_ID",+ABMLNPI),U)>0:$P($$NPI^XUSNPI("Organization_ID",+ABMLNPI),U)_"*",1:"")
  1.  ..;end new code HEAT4207
  1.  ..W ?50,ABM("DISC")
  1.  ;
  1.  I ABMNPIUS="B" D
  1.  .W !,ABMTYP($P(ABM("X0"),U,2))
  1.  .I $D(ABM($P(ABM("X0"),U,2))) D
  1.  ..W ?8,$E($P(ABM($P(ABM("X0"),U,2)),U),1,20)
  1.  ..;W ?30,$S($P($$NPI^XUSNPI("Individual_ID",+ABM("X0")),U)>0:$P($$NPI^XUSNPI("Individual_ID",+ABM("X0")),U),$P($$NPI^XUSNPI("Organization_ID",+ABMP("LDFN")),U)>0:$P($$NPI^XUSNPI("Organization_ID",+ABMP("LDFN")),U)_"*",1:"")  ;abm*2.6*1 HEAT4207
  1.  ..;start new code abm*2.6*1 HEAT4207
  1.  ..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"))
  1.  ..;W ?30,$S($P($$NPI^XUSNPI("Individual_ID",+ABM("X0")),U)>0:$P($$NPI^XUSNPI("Individual_ID",+ABM("X0")),U),$P($$NPI^XUSNPI("Organization_ID",+ABMLNPI),U)>0:$P($$NPI^XUSNPI("Organization_ID",+ABMLNPI),U)_"*",1:"")  ;abm*2.6*1
  1.  ..;end new code HEAT4207
  1.  ..S ABMNPI=0
  1.  ..S ABMNPI=$P($$NPI^XUSNPI("Individual_ID",+ABM("X0")),U)
  1.  ..I +ABMNPI<1 S ABMNPI=$P($$NPI^XUSNPI("Organization_ID",+ABMP("LDFN")),U)_"*"
  1.  ..W ?30,ABMNPI
  1.  ..W ?42,ABM("PNUM")
  1.  ..W ?55,ABM("DISC")
  1.  Q
  1.  ;
  1. A1 ; Add Multiple
  1.  W ! K DIC
  1.  S DIC="^VA(200,",DIC(0)="QEAM"
  1.  S DIC("A")="Select "_ABM("ITEM")_": "
  1.  S DIC("S")="I $D(^VA(200,Y,""PS""))"
  1.  D ^DIC K DIC
  1.  Q:$D(DTOUT)!$D(DUOUT)!$D(DIROUT)!(X="")
  1.  I $D(ABM("A")) S ABM("ANS")="O"
  1.  E  S ABM("ANS")="A"
  1.  W ! S ABM("Y")=Y
  1.  S DIR(0)="S^A:Attending;O:Operating;T:Other;F:Referring;R:Rendering;P:Purchased Service;S:Supervising"
  1.  S DIR("A")="Provider Status",DIR("B")=ABM("ANS")
  1.  D ^DIR K DIR Q:$D(DTOUT)!$D(DUOUT)!$D(DIROUT)
  1.  S ABM("ANS")=Y,Y=ABM("Y")
  1.  I $D(ABM("A"))&(ABM("ANS")="A") W !!?5,*7,"***Attending Provider are Already Established!***",!?5,"      (Delete as necessary to facilitate editing)",! H 2 Q
  1.  I $D(ABM("O"))&(ABM("ANS")="O") W !!?5,*7,"***Operating Provider are Already Established!***",!?5,"      (Delete as necessary to facilitate editing)",! H 2 Q
  1. A2 I +Y>0 K DD,DO S X=+Y,DA(1)=ABMP("CDFN"),DIC="^ABMDCLM(DUZ(2),"_DA(1)_","_ABM("SUB")_",",DIC("DR")=".02////"_ABM("ANS"),DIC(0)="LE"
  1.  I  S:ABM("NUM")=0 ^ABMDCLM(DUZ(2),DA(1),ABM("SUB"),0)="^9002274.30"_ABM("SUB")_"P^^" D FILE^DICN
  1.  Q
  1.  ;
  1. D1 ; Delete Multiple
  1.  K DA
  1.  I ABM("NUM")=0 W *7 Q
  1.  S DIC="^ABMDCLM(DUZ(2),ABMP(""CDFN""),41,",DIC(0)="AEMQ"
  1.  I ABM("NUM")=1 S DA=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),41,0))
  1.  I '$G(DA) D
  1.  .S DIC("A")="Select Provider: " D ^DIC
  1.  .Q:+Y<0  S DA=+Y
  1.  Q:'$G(DA)
  1.  S DIR(0)="Y",DIR("A")="SURE",DIR("B")="NO" D ^DIR K DIR Q:Y'=1
  1.  S DIK=DIC,DA(1)=ABMP("CDFN") D ^DIK
  1.  K DIC
  1.  Q
  1.  ;
  1. XIT K ABM,ABME
  1.  Q