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

ABMDBDIC.m

Go to the documentation of this file. 
  1. ABMDBDIC ; IHS/ASDST/DMJ - Bill Selection ;  
  1.  ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
  1.  ;
  1.  ;IHS/DSD/MRS - 5/21/1999 - NOIS QDA-599-130046 Patch 3 #1
  1.  ;     Added check for missing insurer data
  1.  ;
  1.  ;IHS/PIMC/JLG - 8/20/02 - V2.5 P2
  1.  ;     Modified so IQMG option would only look at one bill.  Thanks to
  1.  ;     Jim Gray for the code.
  1.  ;
  1.  ; IHS/SD/SDR - v2.5 p11 - Adrian supplied the following changes
  1.  ;
  1.  ; IHS/SD/SDR - v2.5 p12 - Added code to look up by UFMS invoice number
  1.  ;   using x-ref UINV
  1.  ;
  1. BILL ;EP - SELECT BILL
  1.  K %P,DIC,ABMP("BDFN"),ABM
  1.  S DIR("A")="Select BILL or PATIENT"
  1.  S DIR("?")="Enter either the Bill Number or a Patient Identifier (Name, HRN, SSN, DOB)"
  1.  W !
  1.  S DIR(0)="FO" D ^DIR K DIR
  1.  Q:$D(DIRUT)
  1.  S ABM("INPUT")=Y
  1.  I Y=" " D  Q
  1.  .S DIC="^ABMDBILL(DUZ(2),",DIC(0)="EMQ",X=Y
  1.  .D ^DIC Q:+Y<0
  1.  .S ABMP("BDFN")=+Y
  1.  I ($D(^ABMDBILL(DUZ(2),"B",Y))&(Y'=+Y))!($D(^ABMDBILL(DUZ(2),"UINV",Y))) D
  1.  .S X=Y
  1.  .S DIC="^ABMDBILL(DUZ(2),",DIC(0)="EM" D ^DIC
  1.  .I +Y>0 S ABMP("BDFN")=+Y
  1.  I $G(ABMP("BDFN")) K ABM Q
  1.  I Y=+Y,$D(^ABMDBILL(DUZ(2),"B",Y)) D
  1.  .S X=Y
  1.  .S DIC="^ABMDBILL(DUZ(2),",DIC(0)="EM" D ^DIC
  1.  .I +Y>0 D
  1.  ..S ABMP("BDFN")=+Y
  1.  ..K DIR,DIE,DIC,X,Y,DA
  1.  ..S DIR(0)="Y"
  1.  ..S DIR("A")="Correct Bill",DIR("B")="YES" D ^DIR K DIR
  1.  ..I Y'=1 K ABMP("BDFN")
  1.  I $G(ABMP("BDFN")) K ABM Q
  1.  S ABM("STATUS")=$P(^DD(9002274.4,.04,0),"^",3)
  1. NUM ;NUMBER LOOKUP
  1.  S Y=ABM("INPUT")
  1.  I +Y D
  1.  .S J=+Y_" "
  1.  .S ABM("CNT")=0
  1.  .F  S J=$O(^ABMDBILL(DUZ(2),"B",J)) Q:J'[+ABM("INPUT")!($G(ABMP("BDFN")))  D
  1.  ..S I=$O(^ABMDBILL(DUZ(2),"B",J,0))
  1.  ..S ABMP("PDFN")=$P(^ABMDBILL(DUZ(2),I,0),"^",5)
  1.  ..D ID
  1.  .D:(ABM("CNT")#5) SEL
  1.  I $G(ABMP("BDFN")) K ABM Q
  1. PAT ;PATIENT LOOKUP     
  1.  S X=ABM("INPUT"),DIC="^AUPNPAT(",DIC(0)="EMQ",AUPNLK("ALL")=1
  1.  D ^DIC
  1.  I +Y<0 G BILL
  1.  S ABMP("PDFN")=+Y,ABM("P0")=^DPT(ABMP("PDFN"),0)
  1.  S $P(ABM("="),"=",80)=""
  1.  D PAT^ABMDUTL(ABMP("PDFN"))
  1.  S I="",ABM("CNT")=0 F  S I=$O(^ABMDBILL(DUZ(2),"D",ABMP("PDFN"),I),-1) Q:'I!($G(ABMP("BDFN")))!($D(DIRUT))  D ID
  1.  D:(ABM("CNT")#5) SEL
  1.  I '$G(ABMP("BDFN")) G BILL
  1.  K ABM Q
  1. ID ;BILL IDENTIFIERS
  1.  I '(ABM("CNT")#5) D PAT^ABMDUTL(ABMP("PDFN"))
  1.  S ABM("CNT")=ABM("CNT")+1
  1.  S ABM("CNT",ABM("CNT"))=I
  1.  W !!,"(",ABM("CNT"),")"
  1.  S ABM("ZERO")=^ABMDBILL(DUZ(2),I,0) N J F J=1:1:12 S ABM(J)=$P(ABM("ZERO"),"^",J)
  1.  S ABM(7,1)=$P($G(^ABMDBILL(DUZ(2),I,7)),"^",1),ABM(2,1)=$P($G(^(2)),"^",1)
  1.  S ABM(4)=$P(ABM("STATUS"),ABM(4)_":",2),ABM(4)=$P(ABM(4),";",1)
  1.  W ?5,"Bill# ",ABM(1)
  1.  W ?20,$$SDT^ABMDUTL(ABM(7,1))
  1.  ;Realignment of bill inquiry
  1.  W ?32,$E($P($G(^ABMDVTYP(+ABM(7),0)),U),1,17)
  1.  ;Realignment of bill inquiry
  1.  W ?51,$E($P($G(^DIC(40.7,+ABM(10),0)),U),1,13)
  1.  W ?67,$P($G(^AUTTLOC(+ABM(3),0)),"^",2)
  1.  W !,?6,$P($G(^ABMDEXP(+ABM(6),0)),"^",1)
  1.  ;realignment of Bill Inquiry
  1.  W ?22,$E(ABM(4),1,15)
  1.  W ?37,$P($G(^AUTNINS(+ABM(8),0)),"^",1)
  1.  W ?70,$J($FN(ABM(2,1),",",2),10)
  1.  I '(ABM("CNT")#5) D SEL
  1.  Q
  1. SEL ;SELECT
  1.  F  W ! Q:$Y+4>IOSL
  1.  S DIR(0)="NAO^1:"_ABM("CNT"),DIR("A")="Select 1 to "_ABM("CNT")_": " D ^DIR K DIR
  1.  I Y S ABMP("BDFN")=ABM("CNT",Y)
  1.  I Y="",'$D(DTOUT) K DIRUT
  1.  Q
  1.  ;
  1. BENT ;EP - for doing Bill File lookup with DIC variables
  1.  K ABMP("BDFN")
  1.  S AUPNLK("ALL")=1
  1.  S DIC("W")="S ABM(0)=^(0),ABM(2)=+$G(^(2)),ABM(7)=$S(+$G(^(7)):^(7),1:+$G(^(6))) D DICW^ABMDBDIC"
  1.  D ^DIC K DIC
  1.  G XIT:X=""!$D(DUOUT)!$D(DTOUT)
  1.  I X="?" W !!,"Enter either the Bill Number or a Patient Identifier (Name, HRN, SSN, DOB)"
  1.  G BENT:+Y<1 S ABMP("BDFN")=+Y
  1.  G XIT
  1.  ;
  1. DICW ;EP - for displaying bill identifiers
  1.  I $G(DZ)["?",$P(ABM(0),U,5),$D(^DPT($P(ABM(0),U,5),0)) S ABMDPT=^(0) D
  1.  .W ?12,$P(ABMDPT,U)
  1.  .W ?46,$P(ABMDPT,U,2)," "
  1.  .W $$HDT^ABMDUTL($P(ABMDPT,U,3))
  1.  .W " ",$P(ABMDPT,U,9)
  1.  I  I $G(DUZ(2)),$D(^AUPNPAT($P(ABM(0),U,5),41,DUZ(2),0)) W ?68,$P($G(^AUTTLOC(DUZ(2),0)),U,7)," ",$P(^AUPNPAT($P(ABM(0),U,5),41,DUZ(2),0),U,2)
  1.  I $G(X)'=$P(ABM(0),U,5)!($G(DZ)["?") W !
  1.  W ?17,"Visit: ",$$HDT^ABMDUTL(ABM(7))," "
  1.  I $P(ABM(0),U,7) W $E($P($G(^ABMDVTYP($P(ABM(0),U,7),0)),U),1,14)
  1.  I $P(ABM(0),U,10),$P(ABM(0),U,3) W ?49,$E($P($G(^DIC(40.7,$P(ABM(0),U,10),0)),U),1,17),?68,$E($P($G(^AUTTLOC($P(ABM(0),U,3),0)),U,2),1,12)
  1.  I $P(ABM(0),U,8) W !?20,"Bill: ",$P(^AUTNINS($P(ABM(0),U,8),0),U)
  1.  I $P(ABM(0),U,6) W ?57,$P($G(^ABMDEXP($P(ABM(0),U,6),0)),U)
  1.  W ?68,$J($FN(ABM(2),",",2),10)
  1.  S DIW=1
  1.  I $G(DZ)["?" W !
  1.  K ABM(0),ABM(7)
  1.  Q
  1.  ;
  1. XIT K ABM
  1.  Q
  1.  ;
  1. MULT ;EP for Selecting Multiple Bills
  1.  K DIC S ABM("C")=0,DIC="^ABMDBILL(DUZ(2),",DIC(0)="QEAM" W !
  1.  F ABM=1:1 W ! D  Q:X=""!$D(DUOUT)!$D(DTOUT)
  1. SELO .S ABM("E")=$E(ABM,$L(ABM)),DIC("A")="Select "_ABM_$S(ABM>3&(ABM<21):"th",ABM("E")=1:"st",ABM("E")=2:"nd",ABM("E")=3:"rd",1:"th")_" BILL: ",DIC(0)="QEAM" D ^DIC
  1.  .Q:X=""!$D(DUOUT)!$D(DTOUT)
  1.  .I +Y<1 G SELO
  1.  .S ABMM(+Y)=""
  1.  K DIC
  1.  G XIT