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

ABMDBADD.m

Go to the documentation of this file. 
  1. ABMDBADD ; IHS/SD/SDR - Add Bill Manually Submitted ;   
  1.  ;;2.6;IHS Third Party Billing;**1,9,21**;NOV 12, 2009;Build 379
  1.  ;
  1. DOC ;
  1.  ; LSL - 12/30/97 - Modified for readability.  Changed ABM array to ABMD array as
  1.  ;    ABMAPASS and A/R routines stomp all over ABM array.  Also, add the storage of
  1.  ;    Approved Date and Time for A/R usage.  Will be date and time bill is manually created.
  1.  ; LSL - 1/23/98 - Added the storage of the 13 multiple to the bill file.  Many other programs
  1.  ;     in 3PB and A/R assume it exists.
  1.  ; LSL - 2/2/98 - Allow duplicate bills if user ok.  Also allow multiple clinics on same visit date.
  1.  ; LSL - 3/25/98 - Lost value of %, so set approval date variable sooner
  1.  ; 
  1.  ; IHS/ASDS/SDH - 03/09/01 - V2.4 Patch 9 - NOIS LTA-0600-160017 - Modified to check if service
  1.  ;     thru date is less than service from date
  1.  ;
  1.  ; IHS/ASDS/SDH - 10/16/01 - V2.4 Patch 9 - NOIS UOB-0701-170024 - Modified to use ABM utility to
  1.  ;    get claim number so manually generated claims will have unique numbers.  Also made gross
  1.  ;    amount the same as bill amount.
  1.  ;
  1.  ; IHS/SD/SDR - 9/26/2002 - V2.5 P2 - UOB-0102-170068 - Modified routine to do date check for future dates of 
  1.  ;       service/admission
  1.  ;       
  1.  ; IHS/SD/SDR - v2.5 p8 - IM11831 - Modified to prompt for visit location
  1.  ;
  1.  ; IHS/SD/SDR - v2.5 p12 - UFMS - If user isn't logged into cashiering session they can't do
  1.  ;   this option.  Also added so if they enter a bill using this option it will add to cashiering session
  1.  ; IHS/SD/SDR - abm*2.6*1 - HEAT7431 - <SUBSCR>V^DIED (vars from previous FM call still defined.
  1.  ;IHS/SD/SDR - 2.6*21 - VMBP RQMT_111 - fixed insurer type code
  1.  ;IHS/SD/SDR - 2.6*21 - HEAT175003 - Made change for <SUBSCR>ISET+33^ABMERUTL; occurs when trying to file elig pointer into record.  There was no ';' to
  1.  ;  separate data
  1.  ;
  1.  ; *********************************************************************
  1.  ;
  1. START ;EP
  1.  K ABMD
  1.  W !!?5,$$EN^ABMVDF("RVN"),"NOTE:",$$EN^ABMVDF("RVF")
  1.  W " This program should only be utilized when an entry in the"
  1.  W !?11,"Accounts Receivable File is needed to reflect a bill that"
  1.  W !?11,"was manually prepared and submitted.",!
  1.  S DIR(0)="Y"
  1.  S DIR("A")="Proceed"
  1.  S DIR("B")="NO"
  1.  D ^DIR
  1.  K DIR
  1.  Q:Y'=1
  1.  ;start new code abm*2.6*9 NOHEAT - ensure UFMS is setup
  1.  I $P($G(^ABMDPARM(DUZ(2),1,4)),U,15)="" D  Q
  1.  .W !!,"* * UFMS SETUP MUST BE DONE BEFORE ANY BILLING FUNCTIONS CAN BE USED! * *",!
  1.  .S DIR(0)="E",DIR("A")="Enter RETURN to Continue" D ^DIR K DIR
  1.  ;end new code
  1.  I $P($G(^ABMDPARM(DUZ(2),1,4)),U,15)=1 D  Q:+$G(ABMUOPNS)=0
  1.  .S ABMUOPNS=$$FINDOPEN^ABMUCUTL(DUZ)
  1.  .I +$G(ABMUOPNS)=0 D  Q
  1.  ..W !!,"* * YOU MUST SIGN IN TO BE ABLE TO PERFORM BILLING FUNCTIONS! * *",!
  1.  ..S DIR(0)="E",DIR("A")="Enter RETURN to Continue" D ^DIR K DIR
  1.  ;
  1. ASK ; ask what visit location if Parent/Satellite is set up
  1.  S ABMARPS=$P($G(^ABMDPARM(DUZ(2),1,4)),U,9)  ;A/R P/S?
  1.  I ABMARPS D
  1.  .K DIC
  1.  .S DIC="^BAR(90052.05,DUZ(2),"
  1.  .S DIC(0)="AME"
  1.  .S DIC("A")="Visit Location: "
  1.  .S DIC("B")=DUZ(2)
  1.  .D ^DIC
  1.  Q:$D(DUOUT)!$D(DTOUT)
  1.  Q:+Y<0
  1. ADD ;
  1.  I ABMARPS D
  1.  .S ABMDUZ2=DUZ(2)
  1.  .S ABMUDUZ2=+Y
  1.  .S DUZ(2)=ABMUDUZ2
  1.  S ABMD("DFN")=$$NXNM^ABMDUTL
  1.  K DINUM
  1.  S DIC="^ABMDBILL(DUZ(2),"
  1.  S DIC(0)="L"
  1.  S X=ABMD("DFN")
  1.  K DD,DO D FILE^DICN                     ; Add entry to 3P BILL 
  1.  I +Y<1 D  G XIT
  1.  .W *7
  1.  .W !!,"ERROR: BILL NOT CREATED, ensure your Fileman ACCESS CODE contains a 'V'.",!!
  1.  S ABMD("DFN")=+Y                        ; 3P BILL ien
  1.  ;
  1. EDIT ;
  1.  L +^ABMDBILL(DUZ(2),ABMD("DFN")):1      ; Lock entry in 3P BILL
  1.  I '$T W *7,!!,"Bill not created, Bill File in use by another user, try Later!" G XIT
  1. E2 ;
  1.  ;BYPASS LOCK
  1.  W !
  1.  K DIC,DIE,DA,DR,X,Y  ;abm*2.6*1 HEAT7431
  1.  S DA=ABMD("DFN")                        ; 3P BILL ien
  1.  S DIE="^ABMDBILL(DUZ(2),"               ; 3P BILL file
  1.  S DR=".03////"_DUZ(2)                   ; Facility
  1.  S DR=DR_";.05R~Patient........: "       ; Patient pointer
  1.  S DR=DR_";.07R~Visit Type.....: "       ; Visit type
  1.  S DR=DR_";.1R~Clinic.........: "        ; clinic
  1.  D ^DIE                                  ; add fields to 3P BILL entry
  1.  G KILL:$D(Y)                            ; if ^ out, kill entry
  1.  ;
  1.  ; If not inpatient ask Serv date from and thru and No of 
  1.  ; outpatient visits.
  1. SVDTS ;   
  1.  I $P(^ABMDBILL(DUZ(2),DA,0),U,7)'=111 D  G KILL:$D(Y)
  1.  .S DR=".71R~Serv Date From.: "
  1.  .D ^DIE
  1.  .Q:$D(Y)
  1.  .S ABMSVFRM=X
  1.  .I X>DT D  I Y=0 K Y G SVDTS
  1.  ..S DIR(0)="Y"
  1.  ..S DIR("A")="Wait!  You are entering a DOS in the future...Do you wish to proceed?"
  1.  ..S DIR("B")="N"
  1.  ..D ^DIR
  1.  .S DR=".72////"_$P(^ABMDBILL(DUZ(2),DA,7),U)
  1.  .D ^DIE
  1.  .S DR=".72Serv Date Thru.: "
  1.  .D ^DIE
  1.  .Q:$D(Y)
  1.  .S ABMSVTRU=X
  1.  .I X>DT D  I Y=0 K Y G SVDTS
  1.  ..S DIR(0)="Y"
  1.  ..S DIR("A")="Wait!  You are entering a DOS in the future...Do you wish to proceed?"
  1.  ..S DIR("B")="N"
  1.  ..D ^DIR
  1.  .I ABMSVTRU<ABMSVFRM W !,"Service Thru Date cannot be less than Service From Date....",! G SVDTS
  1.  .S DR=".69R~No. of Visits..: //1"
  1.  .D ^DIE
  1.  .Q:$D(Y)
  1.  ;
  1.  ; If inpatient ask Adm and Dsch date, set Serv to and from dates
  1.  ; based on Adm and Dsch dates, calc covered days, and delete
  1.  ; No of outpatient visits.
  1. ADMDTS I $P(^ABMDBILL(DUZ(2),DA,0),U,7)=111 D  G KILL:$D(Y)
  1.  .S DR=".61R~Admission Date.: "
  1.  .D ^DIE
  1.  .Q:$D(Y)
  1.  .I X>DT D  I Y=0 K Y G ADMDTS
  1.  ..S DIR(0)="Y"
  1.  ..S DIR("A")="Wait!  You are entering a DOS in the future...Do you wish to proceed?"
  1.  ..S DIR("B")="N"
  1.  ..D ^DIR
  1.  .S DR=".63R~Discharge Date.: "
  1.  .D ^DIE
  1.  .Q:$D(Y)
  1.  .I X>DT D  I Y=0 K Y G ADMDTS
  1.  ..S DIR(0)="Y"
  1.  ..S DIR("A")="Wait!  You are entering a DOS in the future...Do you wish to proceed?"
  1.  ..S DIR("B")="N"
  1.  ..D ^DIR
  1.  .S X2=$P(^ABMDBILL(DUZ(2),DA,6),U)
  1.  .S X1=$P(^ABMDBILL(DUZ(2),DA,6),U,3)
  1.  .D ^%DTC
  1.  .S ABMD("DAYS")=$S(X>0:X,1:1)
  1.  .S DR=".71////"_$P(^ABMDBILL(DUZ(2),ABMD("DFN"),6),U)
  1.  .S DR=DR_";.72////"_$P(^(6),U,3)
  1.  .S DR=DR_";.73////"_ABMD("DAYS")
  1.  .S DR=DR_";.69///@"
  1.  .D ^DIE
  1.  .Q:$D(Y)
  1.  ;
  1. CHK ;
  1.  S ABMD(0)=$G(^ABMDBILL(DUZ(2),ABMD("DFN"),0))
  1.  S ABMD("DUP")=0
  1.  S ABMD("R")=""
  1.  S ABMD("P")=$P(ABMD(0),U,5)             ; Patient pointer
  1.  S ABMD("L")=$P(ABMD(0),U,3)             ; Facility
  1.  S ABMD("T")=$P(ABMD(0),U,7)             ; Visit type
  1.  S ABMD("C")=$P(ABMD(0),U,10)            ; clinic IEN
  1.  S ABMD("D")=$P(^ABMDBILL(DUZ(2),ABMD("DFN"),7),U)  ; Serv date from
  1.  ; Check Serv date from cross-ref for duplicate bills
  1.  F  S ABMD("R")=$O(^ABMDBILL(DUZ(2),"AD",ABMD("D"),ABMD("R"))) Q:'ABMD("R")  D
  1.  .Q:ABMD("R")=ABMD("DFN")               ; Q if this bill number
  1.  .I '$D(^ABMDBILL(DUZ(2),ABMD("R"),0)) K ^ABMDBILL(DUZ(2),"AD",ABMD("D"),ABMD("R")) Q       ;if no data, kill cross-ref,Q
  1.  .S ABMD(0)=^ABMDBILL(DUZ(2),ABMD("R"),0)  ; 0 node of new bill found
  1.  .I $P(ABMD(0),U,3)=ABMD("L"),$P(ABMD(0),U,7)=ABMD("T"),$P(ABMD(0),U,5)=ABMD("P") D
  1.  ..S ABMD("DUP")=1
  1.  ..S ABMD("Z",$P(ABMD(0),U))=$P($G(^DIC(40.7,$P(ABMD(0),U,10),0)),U)
  1.  ..I $P(ABMD(0),U,10)=ABMD("C") S $P(ABMD("Z",$P(ABMD(0),U)),U,2)="D"
  1.  I ABMD("DUP") D  G KILL:ABMD("DUP")
  1.  .W !!,"This patient also has the following bills on file for this visit date:",!
  1.  .S ABMD("B")=""
  1.  .F  S ABMD("B")=$O(ABMD("Z",ABMD("B"))) Q:'ABMD("B")  D
  1.  ..W !,"BILL:  ",ABMD("B"),?18,"CLINIC:  ",$P(ABMD("Z",ABMD("B")),U)
  1.  ..I $P(ABMD("Z",ABMD("B")),U,2)="D" W ?50,"(**DUPLICATE**)"
  1.  .W !
  1.  .S DIR("A")="Proceed"
  1.  .S DIR("B")="NO"
  1.  .S DIR(0)="Y"
  1.  .D ^DIR
  1.  .K DIR
  1.  .S:Y=1 ABMD("DUP")=0
  1.  ;
  1. INS ;
  1.  S DR=".08R~Insurer........: "
  1.  S DR=DR_";.21R~Amount Billed..: "
  1.  D ^DIE
  1.  G KILL:$D(Y)
  1.  S ABMAMT=$P($G(^ABMDBILL(DUZ(2),ABMD("DFN"),2)),U)
  1.  S DR=".23////"_ABMAMT
  1.  D ^DIE
  1.  W !
  1.  S ABMD("INS")=$P(^ABMDBILL(DUZ(2),ABMD("DFN"),0),U,8)
  1.  I $P($G(^AUTNINS(ABMD("INS"),0)),U,11)="",($P($G(^ABMDPARM(DUZ(2),1,4)),U,15)=1) D  G KILL
  1.  .W !,"Insurer ",$P($G(^AUTNINS(ABMD("INS"),0)),U)
  1.  .W !,"is missing Tax Identification Number.  Please add in the Insurer file."
  1.  D ELG^ABMDLCK("",.ABML,ABMD("P"),ABMD("D"))  ; Call Eligibility Checker
  1.  S Y=ABMD("D")
  1.  D DD^%DT
  1.  S ABMD("ED")=Y                               ; external visit date
  1.  S ABMD("PRI")=""
  1.  F  S ABMD("PRI")=$O(ABML(ABMD("PRI"))) Q:'ABMD("PRI")  D
  1.  .I $D(ABML(ABMD("PRI"),ABMD("INS"))) D
  1.  ..S ABMD("ITYP")=$P(ABML(ABMD("PRI"),ABMD("INS")),U,3)
  1.  ..S ABMD("ELG")=$P(ABML(ABMD("PRI"),ABMD("INS")),U,2)
  1.  ..S ABMD("MCD")=$P(ABML(ABMD("PRI"),ABMD("INS")),U)
  1.  K ABML
  1.  I '$D(ABMD("ELG")) D
  1.  .W !,$P(^DPT($P(^AUPNPAT(ABMD("P"),0),U),0),U)
  1.  .W " has NO ELIGIBILITY for "
  1.  .W $P(^AUTNINS(ABMD("INS"),0),U)
  1.  .W " on ",ABMD("ED"),!
  1.  S DIR(0)="Y"
  1.  S DIR("A")="File Bill"
  1.  S DIR("B")="NO"
  1.  D ^DIR
  1.  K DIR
  1.  I Y'=1 G E2  ; If not file bill, ask info again.
  1.  ; Insurer Type
  1.  ;S ABMD("IT")=$P($G(^AUTNINS(ABMD("INS"),2)),U,1)  ;abm*2.6*21 IHS/SD/SDR VMBP RQMT_111
  1.  S ABMD("IT")=$$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,+ABMD("INS"),".211","I"),1,"I")  ;abm*2.6*21 IHS/SD/SDR VMBP RQMT_111
  1.  S:"FHM"[ABMD("IT") ABMD("IT")="P"
  1.  D NOW^%DTC
  1.  S ABMD("APDT")=%
  1.  S DA=1
  1.  ;S DIC="^ABMDBILL(DUZ(2),DA(1),13,"  ;abm*2.6*21 IHS/SD/SDR HEAT175003
  1.  S DA(1)=ABMD("DFN")
  1.  S DIC="^ABMDBILL(DUZ(2),"_DA(1)_",13,"  ;abm*2.6*21 IHS/SD/SDR HEAT175003
  1.  S X=ABMD("INS")                               ; Insurer
  1.  S DIC(0)="LE"
  1.  S DIC("P")=$P(^DD(9002274.4,13,0),U,2)
  1.  S DIC("DR")=".02///1"                         ; Priority
  1.  ;S DIC("DR")=DIC("DR")_";.03///INITIATED"      ; Status  ;abm*2.6*21 IHS/SD/SDR HEAT175003
  1.  S DIC("DR")=DIC("DR")_";.03////I"      ; Status  ;abm*2.6*21 IHS/SD/SDR HEAT175003
  1.  I $D(ABMD("ELG")) D
  1.  .I ABMD("ITYP")?1(1"P",1"W",1"A") S DIC("DR")=DIC("DR")_";.08///"_ABMD("ELG")
  1.  .;start old code abm*2.6*21 IHS/SD/SDR HEAT175003
  1.  .;I ABMD("ITYP")="M" S DIC("DR")=DIC("DR")_".04///"_ABMD("ELG")
  1.  .;I ABMD("ITYP")="R" S DIC("DR")=DIC("DR")_".05///"_ABMD("ELG")
  1.  .;I ABMD("ITYP")="D" D
  1.  .;.S DIC("DR")=DIC("DR")_".07///"_ABMD("ELG")
  1.  .;.S DIC("DR")=DIC("DR")_".06////"_ABMD("MCD")
  1.  .;end old start new abm*2.6*21 IHS/SD/SDR HEAT175003
  1.  .I ABMD("ITYP")="M" S DIC("DR")=DIC("DR")_";.04///"_ABMD("ELG")
  1.  .I ABMD("ITYP")="R" S DIC("DR")=DIC("DR")_";.05///"_ABMD("ELG")
  1.  .I ABMD("ITYP")="D" D
  1.  ..S DIC("DR")=DIC("DR")_";.07////"_ABMD("ELG")
  1.  ..S DIC("DR")=DIC("DR")_";.06////"_ABMD("MCD")
  1.  .;end new  abm*2.6*21 IHS/SD/SDR HEAT175003
  1.  .I ABMD("ITYP")="V" S DIC("DR")=DIC("DR")_";.013///"_ABMD("ELG")  ;abm*2.6*21 IHS/SD/SDR VMBP RQMT_111
  1.  K DD,DO D FILE^DICN
  1.  S DA=ABMD("DFN")
  1.  S DR=".14////"_DUZ                      ; Approving Official
  1.  S DR=DR_";.15////"_ABMD("APDT")         ; Approval date and time
  1.  S DR=DR_";.22////"_ABMD("IT")           ; Insurer Type
  1.  S DR=DR_";.04////B"                     ; Bill Status
  1.  S DR=DR_";.16////A"                     ; Export Status
  1.  S ABMAPOK=1                 ; Set so .04 x-ref will call ABMAPASS
  1.  D ^DIE
  1.  I ABMARPS S DUZ(2)=ABMUDUZ2
  1.  W !,"Bill # ",$P(^ABMDBILL(DUZ(2),DA,0),"^",1)," Filed.",!
  1.  D ADDBENTR^ABMUCUTL("ABILL",ABMP("BDFN"))  ;add bill to UFMS Cash. Session
  1.  ;
  1. XIT ;
  1.  L -^ABMDBILL(DUZ(2),ABMD("DFN"))
  1.  K DIR
  1.  S DIR(0)="E"
  1.  D ^DIR
  1.  K ABMD,ABMAPOK
  1.  I ABMARPS S DUZ(2)=ABMDUZ2
  1.  Q
  1.  ;
  1. KILL ;
  1.  W !!,*7,"<Data Incomplete: Entry Deleted>"
  1.  S DIK=DIE
  1.  D ^DIK
  1.  G XIT