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