ABMDSPLT ; IHS/ASDST/DMJ - SPLIT CLAIM IN TWO ;
;;2.6;IHS Third Party Billing;**1,3,9,10,21**;NOV 12, 2009;Build 379
;
; IHS/SD/SDR - v2.5 p12 - UFMS
; Added check to see if user is logged in before splitting
; claims allowed
; IHS/SD/SDR - abm*2.6*1 - HEAT4480 - Added ARE YOU SURE prior to split
; IHS/SD/SDR - abm*2.6*3 - HEAT11948 - fix for <UNDEF>START+3^AUPNPAT
;IHS/SD/SDR - 2.6*21 - HEAT190661 - If user types '^' at section prompt they will be exited out of option without split.
; Also rearranged code so claim wouldn't get created until sections to be copied/moved were selected.
;
; *********************************************************************
;
START ;START
W !
;start new code abm*2.6*9 NOHEAT - ensure UFMS is setup
I $P($G(^ABMDPARM(DUZ(2),1,4)),U,15)="" D Q
.W !!,"* * UFMS SETUP MUST BE DONE BEFORE ANY BILLING FUNCTIONS CAN BE USED! * *",!
.S DIR(0)="E",DIR("A")="Enter RETURN to Continue" D ^DIR K DIR
;end new code
I $P($G(^ABMDPARM(DUZ(2),1,4)),U,15)=1 D Q:+$G(ABMUOPNS)=0
.S ABMUOPNS=$$FINDOPEN^ABMUCUTL(DUZ)
.I +$G(ABMUOPNS)=0 D Q
..W !!,"* * YOU MUST SIGN IN TO BE ABLE TO PERFORM BILLING FUNCTIONS! * *",!
..S DIR(0)="E",DIR("A")="Enter RETURN to Continue" D ^DIR K DIR
D ^ABMDEDIC
Q:'$G(ABMP("CDFN"))
S DIC="^ABMDCLM(DUZ(2),",DIC(0)="L"
S X=$P(^ABMDCLM(DUZ(2),ABMP("CDFN"),0),U)
;start new code abm*2.6*1 HEAT4480
W !!
S DIR(0)="Y",DIR("A")="You are about to split a claim. Are you sure?"
S DIR("B")="NO"
D ^DIR K DIR
G:Y=0 START
;S X=$P(^ABMDCLM(DUZ(2),ABMP("CDFN"),0),U) ;abm*2.6*3 HEAT11948 ;abm*2.6*21 IHS/SD/SDR 190661
;end new code HEAT4480
;start old abm*2.6*21 IHS/SD/SDR HEAT190661
;S DINUM=$$NXNM^ABMDUTL
;I DINUM="" D Q
;.W !!,"ERROR: Claim not created - check global ^ABMDCLM(0)"
;.S DIR(0)="E" D ^DIR K DIR
;K DD,DO D FILE^DICN Q:+Y<0 S ABMC2=+Y
;M ^ABMDCLM(DUZ(2),ABMC2)=^ABMDCLM(DUZ(2),ABMP("CDFN"))
;S DIE="^ABMDCLM(DUZ(2),"
;S DA=ABMC2
;S DR=".1////"_DT_";.04///E"
;S DR=DR_";.17////"_DT
;S DR=DR_";.022////S" ;abm*2.6*10 ICD10 008
;D ^DIE
;;start new code ;abm*2.6*10 ICD10 008
;S DIE="^ABMDCLM(DUZ(2),"
;S DA=ABMP("CDFN")
;S DR=".022////O" ;abm*2.6*10 ICD10 008
;D ^DIE
;end new code 008
;end old abm*2.6*21 IHS/SD/SDR HEAT190661
MLI ;MOVE LINE ITEMS
S ABMSTRG=""
S DIR(0)="SO^8A:MEDICAL;8B:SURGICAL;8C:REVENUE CODE;8D:RX;8E:LAB;8F:RADIOLOGY;8G:ANESTHESIA;8H:HCPCS;8I:INPATIENT DENTAL;8J:CHARGE MASTER;8Z:ALL"
S DIR("A")="Move Which Section(s)? "
F D Q:'Y
.D ^DIR
.Q:'Y
.S:ABMSTRG'[Y ABMSTRG=ABMSTRG_Y_"^"
.W !!,"Selected: ",$TR(ABMSTRG,"^"," ")
;start new abm*2.6*21 IHS/SD/SDR HEAT190661
I $D(DTOUT)!$D(DUOUT)!$D(DIROUT) W !!,"Split will not occur..." H 1 Q
S X=$P(^ABMDCLM(DUZ(2),ABMP("CDFN"),0),U)
S DINUM=$$NXNM^ABMDUTL
I DINUM="" D Q
.W !!,"ERROR: Claim not created - check global ^ABMDCLM(0)"
.S DIR(0)="E" D ^DIR K DIR
K DD,DO D FILE^DICN Q:+Y<0 S ABMC2=+Y
M ^ABMDCLM(DUZ(2),ABMC2)=^ABMDCLM(DUZ(2),ABMP("CDFN"))
S DIE="^ABMDCLM(DUZ(2),"
S DA=ABMC2
S DR=".1////"_DT_";.04///E"
S DR=DR_";.17////"_DT
S DR=DR_";.022////S"
D ^DIE
S DIE="^ABMDCLM(DUZ(2),"
S DA=ABMP("CDFN")
S DR=".022////O"
D ^DIE
;end new abm*2.6*21 IHS/SD/SDR HEAT190661
K DIR
W !
I ABMSTRG'["8Z" D
.S DIR(0)="Y",DIR("A")="Delete sections from original claim after move"
.S DIR("B")="NO"
.D ^DIR K DIR
.S:Y=1 ABMDLT=1
D DEL
S DIK="^ABMDCLM(DUZ(2),"
F DA=ABMC2,ABMP("CDFN") D
.K ^ABMDCLM(DUZ(2),DA,"ASRC")
.D IX1^DIK
W !!,"Claim # ",ABMC2," created.",!
K ABMSTRG,ABMDLT,ABMC2,ABMPG,ABMSEC
S DIR(0)="E" D ^DIR K DIR
Q
DEL ;DELETE SECTIONS
K ^ABMDCLM(DUZ(2),ABMC2,13)
F I=1:1:10 D
.S ABMPG=$P("8A^8B^8C^8D^8E^8F^8G^8H^8I^8J","^",I)
.S ABMSEC=$P("27^21^25^23^37^35^39^43^33^45","^",I)
.I $G(ABMDLT),ABMSTRG[ABMPG K ^ABMDCLM(DUZ(2),ABMP("CDFN"),ABMSEC)
.Q:ABMSTRG["8Z"
.I '(ABMSTRG[ABMPG) K ^ABMDCLM(DUZ(2),ABMC2,ABMSEC)
Q
ABMDSPLT ; IHS/ASDST/DMJ - SPLIT CLAIM IN TWO ;
+1 ;;2.6;IHS Third Party Billing;**1,3,9,10,21**;NOV 12, 2009;Build 379
+2 ;
+3 ; IHS/SD/SDR - v2.5 p12 - UFMS
+4 ; Added check to see if user is logged in before splitting
+5 ; claims allowed
+6 ; IHS/SD/SDR - abm*2.6*1 - HEAT4480 - Added ARE YOU SURE prior to split
+7 ; IHS/SD/SDR - abm*2.6*3 - HEAT11948 - fix for <UNDEF>START+3^AUPNPAT
+8 ;IHS/SD/SDR - 2.6*21 - HEAT190661 - If user types '^' at section prompt they will be exited out of option without split.
+9 ; Also rearranged code so claim wouldn't get created until sections to be copied/moved were selected.
+10 ;
+11 ; *********************************************************************
+12 ;
START ;START
+1 WRITE !
+2 ;start new code abm*2.6*9 NOHEAT - ensure UFMS is setup
+3 IF $PIECE($GET(^ABMDPARM(DUZ(2),1,4)),U,15)=""
Begin DoDot:1
+4 WRITE !!,"* * UFMS SETUP MUST BE DONE BEFORE ANY BILLING FUNCTIONS CAN BE USED! * *",!
+5 SET DIR(0)="E"
SET DIR("A")="Enter RETURN to Continue"
DO ^DIR
KILL DIR
End DoDot:1
QUIT
+6 ;end new code
+7 IF $PIECE($GET(^ABMDPARM(DUZ(2),1,4)),U,15)=1
Begin DoDot:1
+8 SET ABMUOPNS=$$FINDOPEN^ABMUCUTL(DUZ)
+9 IF +$GET(ABMUOPNS)=0
Begin DoDot:2
+10 WRITE !!,"* * YOU MUST SIGN IN TO BE ABLE TO PERFORM BILLING FUNCTIONS! * *",!
+11 SET DIR(0)="E"
SET DIR("A")="Enter RETURN to Continue"
DO ^DIR
KILL DIR
End DoDot:2
QUIT
End DoDot:1
IF +$GET(ABMUOPNS)=0
QUIT
+12 DO ^ABMDEDIC
+13 IF '$GET(ABMP("CDFN"))
QUIT
+14 SET DIC="^ABMDCLM(DUZ(2),"
SET DIC(0)="L"
+15 SET X=$PIECE(^ABMDCLM(DUZ(2),ABMP("CDFN"),0),U)
+16 ;start new code abm*2.6*1 HEAT4480
+17 WRITE !!
+18 SET DIR(0)="Y"
SET DIR("A")="You are about to split a claim. Are you sure?"
+19 SET DIR("B")="NO"
+20 DO ^DIR
KILL DIR
+21 IF Y=0
GOTO START
+22 ;S X=$P(^ABMDCLM(DUZ(2),ABMP("CDFN"),0),U) ;abm*2.6*3 HEAT11948 ;abm*2.6*21 IHS/SD/SDR 190661
+23 ;end new code HEAT4480
+24 ;start old abm*2.6*21 IHS/SD/SDR HEAT190661
+25 ;S DINUM=$$NXNM^ABMDUTL
+26 ;I DINUM="" D Q
+27 ;.W !!,"ERROR: Claim not created - check global ^ABMDCLM(0)"
+28 ;.S DIR(0)="E" D ^DIR K DIR
+29 ;K DD,DO D FILE^DICN Q:+Y<0 S ABMC2=+Y
+30 ;M ^ABMDCLM(DUZ(2),ABMC2)=^ABMDCLM(DUZ(2),ABMP("CDFN"))
+31 ;S DIE="^ABMDCLM(DUZ(2),"
+32 ;S DA=ABMC2
+33 ;S DR=".1////"_DT_";.04///E"
+34 ;S DR=DR_";.17////"_DT
+35 ;S DR=DR_";.022////S" ;abm*2.6*10 ICD10 008
+36 ;D ^DIE
+37 ;;start new code ;abm*2.6*10 ICD10 008
+38 ;S DIE="^ABMDCLM(DUZ(2),"
+39 ;S DA=ABMP("CDFN")
+40 ;S DR=".022////O" ;abm*2.6*10 ICD10 008
+41 ;D ^DIE
+42 ;end new code 008
+43 ;end old abm*2.6*21 IHS/SD/SDR HEAT190661
MLI ;MOVE LINE ITEMS
+1 SET ABMSTRG=""
+2 SET DIR(0)="SO^8A:MEDICAL;8B:SURGICAL;8C:REVENUE CODE;8D:RX;8E:LAB;8F:RADIOLOGY;8G:ANESTHESIA;8H:HCPCS;8I:INPATIENT DENTAL;8J:CHARGE MASTER;8Z:ALL"
+3 SET DIR("A")="Move Which Section(s)? "
+4 FOR
Begin DoDot:1
+5 DO ^DIR
+6 IF 'Y
QUIT
+7 IF ABMSTRG'[Y
SET ABMSTRG=ABMSTRG_Y_"^"
+8 WRITE !!,"Selected: ",$TRANSLATE(ABMSTRG,"^"," ")
End DoDot:1
IF 'Y
QUIT
+9 ;start new abm*2.6*21 IHS/SD/SDR HEAT190661
+10 IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
WRITE !!,"Split will not occur..."
HANG 1
QUIT
+11 SET X=$PIECE(^ABMDCLM(DUZ(2),ABMP("CDFN"),0),U)
+12 SET DINUM=$$NXNM^ABMDUTL
+13 IF DINUM=""
Begin DoDot:1
+14 WRITE !!,"ERROR: Claim not created - check global ^ABMDCLM(0)"
+15 SET DIR(0)="E"
DO ^DIR
KILL DIR
End DoDot:1
QUIT
+16 KILL DD,DO
DO FILE^DICN
IF +Y<0
QUIT
SET ABMC2=+Y
+17 MERGE ^ABMDCLM(DUZ(2),ABMC2)=^ABMDCLM(DUZ(2),ABMP("CDFN"))
+18 SET DIE="^ABMDCLM(DUZ(2),"
+19 SET DA=ABMC2
+20 SET DR=".1////"_DT_";.04///E"
+21 SET DR=DR_";.17////"_DT
+22 SET DR=DR_";.022////S"
+23 DO ^DIE
+24 SET DIE="^ABMDCLM(DUZ(2),"
+25 SET DA=ABMP("CDFN")
+26 SET DR=".022////O"
+27 DO ^DIE
+28 ;end new abm*2.6*21 IHS/SD/SDR HEAT190661
+29 KILL DIR
+30 WRITE !
+31 IF ABMSTRG'["8Z"
Begin DoDot:1
+32 SET DIR(0)="Y"
SET DIR("A")="Delete sections from original claim after move"
+33 SET DIR("B")="NO"
+34 DO ^DIR
KILL DIR
+35 IF Y=1
SET ABMDLT=1
End DoDot:1
+36 DO DEL
+37 SET DIK="^ABMDCLM(DUZ(2),"
+38 FOR DA=ABMC2,ABMP("CDFN")
Begin DoDot:1
+39 KILL ^ABMDCLM(DUZ(2),DA,"ASRC")
+40 DO IX1^DIK
End DoDot:1
+41 WRITE !!,"Claim # ",ABMC2," created.",!
+42 KILL ABMSTRG,ABMDLT,ABMC2,ABMPG,ABMSEC
+43 SET DIR(0)="E"
DO ^DIR
KILL DIR
+44 QUIT
DEL ;DELETE SECTIONS
+1 KILL ^ABMDCLM(DUZ(2),ABMC2,13)
+2 FOR I=1:1:10
Begin DoDot:1
+3 SET ABMPG=$PIECE("8A^8B^8C^8D^8E^8F^8G^8H^8I^8J","^",I)
+4 SET ABMSEC=$PIECE("27^21^25^23^37^35^39^43^33^45","^",I)
+5 IF $GET(ABMDLT)
IF ABMSTRG[ABMPG
KILL ^ABMDCLM(DUZ(2),ABMP("CDFN"),ABMSEC)
+6 IF ABMSTRG["8Z"
QUIT
+7 IF '(ABMSTRG[ABMPG)
KILL ^ABMDCLM(DUZ(2),ABMC2,ABMSEC)
End DoDot:1
+8 QUIT
