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

ABMDEBIL.m

Go to the documentation of this file. 
  1. ABMDEBIL ; IHS/SD/SDR - Move Claim Data to Bill File ;   
  1.  ;;2.6;IHS 3P BILLING SYSTEM;**6,8,10,14**;NOV 12, 2009;Build 238
  1.  ;
  1.  ; IHS/ASDS/DMJ - 06/11/01 v2.4 p5 - NOIS NEA-0601-180026
  1.  ;     Modified to correct problem with lock table filling up
  1.  ; IHS/ASDS/LSL - 10/09/01 - V2.4 Patch 9 - NOIS NDA-1001-180040
  1.  ;     Allow all lines of remarks to pass from the claim to the bill
  1.  ;
  1.  ; IHS/SD/SDR - v2.5 p8 - IM15307/IM14092 - Put fix to bring MSP Reason onto bill from Pat Reg at time of approval
  1.  ; IHS/SD/EFG - V2.5 P8 - IM16385 - Allows all charges to come over
  1.  ; IHS/SD/SDR - v2.5 p8 - task 6 - Added code for new ambulance multiple 47
  1.  ; IHS/SD/SDR - v2.5 p9 - IM16891 - Display bill number when approved
  1.  ; IHS/SD/SDR - v2.5 p9 - IM16058 - allow approval of bill type 110
  1.  ; IHS/SD/SDR - v2.5 p10 - IM20338 - Bring over 19 multiple to bill
  1.  ; IHS/SD/SDR - v2.5 p12 - UFMS - Added call to populate UFMS Cashiering Sessions will approved bill number
  1.  ;
  1.  ; IHS/SD/SDR - abm*2.6*6 - Added code to populate LINE ITEM CONTROL NUMBER
  1.  ; IHS/SD/SDR - abm*2.6*6 - Added code to populate OTHER BILL IDENTIFIER
  1.  ;IHS/SD/SDR - 2.6*14 ICD10 006 - Added code to populated ICD INDICATOR on bill
  1.  ; *********************************************************************
  1.  K ^ABMDCLM(DUZ(2),ABMP("CDFN"),65),ABMFORM
  1.  N I F I=1:1:10 D
  1.  .S ABMPAGE=$P("27^21^25^23^37^35^39^43^33^45^47","^",I)
  1.  .S ABMFORM(ABMPAGE)=$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),70)),"^",I)
  1.  .S:ABMFORM(ABMPAGE)="" ABMFORM(ABMPAGE)=ABMP("EXP")
  1.  S ABMB("EXP")=0
  1.  F  S ABMB("EXP")=$O(ABMP("EXP",ABMB("EXP"))) Q:'ABMB("EXP")  D GEN:ABMP("EXP",ABMB("EXP"))!($P(ABMP("EXP",ABMB("EXP")),U,2)="Y")!(ABMP("BTYP")=110) Q:$G(ABMB("OUT"))
  1.  G XIT
  1.  ;
  1.  ; *********************************************************************
  1. GEN ;
  1.  K ABMP("BDFN"),ABMP("OVER")
  1.  S ABMB=ABMP("CDFN")
  1.  S ABMB("Y")="A"
  1.  S ABMB("OUT")=0
  1.  F  Q:'$D(^ABMDBILL(DUZ(2),"B",ABMB_ABMB("Y")))  S ABMB("Y")=$C($A(ABMB("Y"))+1)
  1.  S X=ABMB_ABMB("Y")
  1.  S DIC="^ABMDBILL(DUZ(2),"
  1.  S DIC(0)="L"
  1.  K DD,DO
  1.  K Y
  1.  D FILE^DICN
  1.  I +Y<1 D  Q
  1.  . D MSG^ABMERUTL("ERROR: BILL NOT CREATED, ensure your Fileman ACCESS CODE contains a 'V'.")
  1.  . S ABMB("OUT")=1
  1.  L +^ABMDBILL(DUZ(2),+Y):1 I '$T D MSG^ABMERUTL("ERROR: Bill File is Locked by another User, Try Later!") Q
  1.  S ABMP("BDFN")=+Y
  1.  S ^ABMDTMP(ABMP("CDFN"),+Y)=X_U_$H
  1.  ;
  1. MOVE ;
  1.  S ABMB("Y")="^ABMDBILL(DUZ(2),"_ABMP("BDFN")_","
  1.  S ABMB("X")="ABMDCLM("_DUZ(2)_","_ABMP("CDFN")
  1.  S ABMB="^"_ABMB("X")_")"
  1.  F  S ABMB=$Q(@ABMB) Q:ABMB'[ABMB("X")  D
  1.  .S ABMB("Z")=ABMB("Y")_$P($P(ABMB,"(",2),",",3,99)
  1.  .S ABMB("OLDDATA")=@ABMB D
  1.  ..I ABMB("OLDDATA")'["9002274.3" D  Q
  1.  ... S ABMB("NEWDATA")=ABMB("OLDDATA")
  1.  ..F I=1:1:$L(ABMB("OLDDATA"),"9002274.3") S $P(ABMB("NEWDATA"),"9002274.4",I)=$P(ABMB("OLDDATA"),"9002274.3",I)
  1.  .S ABMB("C")=+$P($P(ABMB,"(",2),",",3,99)
  1.  .I ABMB("C")<17!(ABMB("C")=41) D  Q
  1.  ..S @ABMB("Z")=ABMB("NEWDATA")
  1.  .;I $P(^ABMDEXP(ABMB("EXP"),0),U)'["UB",ABMB("C")>50,ABMB("C")<59 Q  ;abm*2.6*6
  1.  .I $G(ABMFORM(ABMB("C"))),ABMFORM(ABMB("C"))'=ABMB("EXP") Q
  1.  .I ABMB("C")=69 Q  ;not merge open/close status
  1.  .S @ABMB("Z")=ABMB("NEWDATA")
  1.  ;
  1. BIL ;
  1.  S $P(^ABMDBILL(DUZ(2),ABMP("BDFN"),0),U)=X
  1.  S $P(^ABMDBILL(DUZ(2),ABMP("BDFN"),0),U,4)="A"
  1.  S $P(^ABMDBILL(DUZ(2),ABMP("BDFN"),0),U,5)=ABMP("PDFN")
  1.  S $P(^ABMDBILL(DUZ(2),ABMP("BDFN"),0),U,6)=ABMB("EXP")
  1.  S $P(^ABMDBILL(DUZ(2),ABMP("BDFN"),0),U,9)=ABMP("PX")
  1.  S ABMAPOK=1
  1.  S $P(^ABMDBILL(DUZ(2),ABMP("BDFN"),0),U,2)=$P(^ABMDCLM(DUZ(2),ABMP("CDFN"),0),U,12)
  1.  S $P(^ABMDBILL(DUZ(2),ABMP("BDFN"),0),U,10)=$P(^ABMDCLM(DUZ(2),ABMP("CDFN"),0),U,6)
  1.  S $P(^ABMDBILL(DUZ(2),ABMP("BDFN"),0),U,21)=$S(ABMP("VDT")>ABMP("ICD10"):"10",1:"9")  ;abm*2.6*14 ICD10 006
  1.  D NOW^%DTC
  1.  S $P(^ABMDBILL(DUZ(2),ABMP("BDFN"),1),U,4)=DUZ
  1.  S $P(^ABMDBILL(DUZ(2),ABMP("BDFN"),1),U,5)=%
  1.  S $P(^ABMDBILL(DUZ(2),ABMP("BDFN"),2),U)=+ABMP("EXP",ABMB("EXP"))
  1.  S $P(^ABMDBILL(DUZ(2),ABMP("BDFN"),2),U,3)=ABMP("TOT")
  1.  S $P(^ABMDBILL(DUZ(2),ABMP("BDFN"),2),U,5)=+$FN(+^ABMDBILL(DUZ(2),ABMP("BDFN"),2),"",2)
  1.  ;S $P(^ABMDBILL(DUZ(2),ABMP("BDFN"),2),U,2)=$P($G(^AUTNINS(ABMP("INS"),2)),U)  ;abm*2.6*10 HEAT73780
  1.  S $P(^ABMDBILL(DUZ(2),ABMP("BDFN"),2),U,2)=$$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,ABMP("INS"),".211","I"),1,"I")  ;abm*2.6*10 HEAT73780
  1.  S $P(^ABMDBILL(DUZ(2),ABMP("BDFN"),2),U,7)=(+$G(ABMP("OBAMT")))
  1.  S:+$G(ABMP("FLAT"))'=0 $P(^ABMDBILL(DUZ(2),ABMP("BDFN"),2),U,8)=$P(+ABMP("FLAT"),U)
  1.  I "FHM"[$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),2)),U,2) S $P(^(2),U,2)="P"
  1.  ;start new code abm*2.6*6 NOHEAT
  1.  S ABM("BLNM")=$P(^ABMDBILL(DUZ(2),ABMP("BDFN"),0),U)
  1.  I $P($G(^ABMDPARM(ABMP("LDFN"),1,2)),"^",4)]"" S ABM("BLNM")=ABM("BLNM")_"-"_$P(^(2),"^",4)
  1.  I $P($G(^ABMDPARM(ABMP("LDFN"),1,3)),"^",3)=1 D
  1.  .S ABM("HRN")=$P($G(^AUPNPAT(ABMP("PDFN"),41,ABMP("LDFN"),0)),"^",2)
  1.  .S:ABM("HRN")]"" ABM("BLNM")=ABM("BLNM")_"-"_ABM("HRN")
  1.  I $L(ABM("BLNM")>14) S $P(^ABMDBILL(DUZ(2),ABMP("BDFN"),1),U,15)=$E(ABM("BLNM"),1,14)
  1.  ;end new code abm*2.6*6 NOHEAT
  1.  ;start new code abm*2.6*6
  1.  ;line iten control number
  1.  S ABMBN=$$FMT^ABMERUTL(ABMP("BDFN"),"12NR")
  1.  I $G(ABMP("FLAT"))'="" D
  1.  .S DIE="^ABMDBILL("_DUZ(2)_","
  1.  .S DA=ABMP("BDFN")
  1.  .S DR=".29////"_ABMBN_"000000"
  1.  .D ^DIE
  1.  I $G(ABMP("FLAT"))="" D
  1.  .K DIC,DIE,DA,DR,X,Y
  1.  .F ABMI=21,23,25,27,33,35,37,39,43,45,47 D
  1.  ..S ABMLNNUM=1
  1.  ..S DA(1)=ABMP("BDFN")
  1.  ..S ABMIEN=0
  1.  ..F  S ABMIEN=$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),ABMI,ABMIEN)) Q:'ABMIEN  D
  1.  ...S ABMLNNUM=$$FMT^ABMERUTL(ABMLNNUM,"4NR")
  1.  ...S DA=ABMIEN
  1.  ...S DIE="^ABMDBILL("_DUZ(2)_","_DA(1)_","_ABMI_","
  1.  ...S DR="21////"_ABMBN_ABMI_ABMLNNUM
  1.  ...D ^DIE
  1.  ...S ABMLNNUM=+$G(ABMLNNUM)+1
  1.  ;end new code
  1.  S DA=ABMP("BDFN")
  1.  S DIK="^ABMDBILL(DUZ(2),"
  1.  D IX1^DIK
  1.  ;I $P($G(^AUTNINS(ABMP("INS"),2)),U)="I" D  ;abm*2.6*10 HEAT73780
  1.  I $$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,ABMP("INS"),".211","I"),1,"I")="I" D  ;abm*2.6*10 HEAT73780
  1.  .S DIE="^ABMDBILL(DUZ(2),"
  1.  .S DR=".04////C"
  1.  .D ^DIE
  1.  I $P($G(^AUTNINS(ABMP("INS"),2)),U,2)]"","YN"'[$P(^(2),U,2) D
  1.  .S DIE="^AUTNINS("
  1.  .S DA=ABMP("INS")
  1.  .S DR=".22////"_$S($D(^ABMNINS(DUZ(2),DA,1,ABMP("VTYP"),11)):"Y",1:"")
  1.  .D ^DIE
  1.  I $G(ABMMSPRS)'="" D  ;MSP reason
  1.  .Q:ABMMSPRS="NO REASON ENTERED"  ;abm*2.6*10 HEAT68467
  1.  .S ABMMSPR=$S(ABMMSPRS="E":12,ABMMSPRS="L":43,ABMMSPRS="V":42,ABMMSPRS="W":15,ABMMSPRS="B":41,1:"14")
  1.  .S $P(^ABMDBILL(DUZ(2),ABMP("BDFN"),12),U)=ABMMSPR
  1.  S (DINUM,X)=ABMP("BDFN")
  1.  S DA(1)=ABMP("CDFN")
  1.  S DIC="^ABMDCLM(DUZ(2),"_DA(1)_",65,"
  1.  S DIC(0)="LE"
  1.  S DIC("P")=$P(^DD(9002274.3,65,0),U,2)
  1.  K DD,DO
  1.  D FILE^DICN
  1.  K DIC
  1.  ;
  1. REM ;REMARKS
  1.  D MSG^ABMERUTL("Bill Number "_$P(^ABMDBILL(DUZ(2),ABMP("BDFN"),0),U)_" Created.  (Export Mode: "_$P(^ABMDEXP(ABMB("EXP"),0),U)_")")
  1.  L -^ABMDBILL(DUZ(2),ABMP("BDFN"))
  1.  D ADDBENTR^ABMUCUTL("ABILL",ABMP("BDFN"))  ;add bill to UFMS Cash. Session
  1.  Q:$D(^ABMDBILL(DUZ(2),ABMP("BDFN"),61))
  1.  N I
  1.  F I=1:1:4 D
  1.  .Q:'$D(^ABMDEXP(ABMP("EXP"),2,I,0))
  1.  .S ^ABMDBILL(DUZ(2),ABMP("BDFN"),61,I,0)=^ABMDEXP(ABMP("EXP"),2,I,0)
  1.  .S ^ABMDBILL(DUZ(2),ABMP("BDFN"),61,0)="^^"_I_"^"_I_"^"_DT
  1.  Q
  1.  ;
  1.  ; *********************************************************************
  1. XIT ;
  1.  K ABMB,ABMS,ABMX,ABMFORM,ABMAPOK
  1.  Q