ABMDEMLA ; IHS/ASDST/DMJ - Edit Utility - FOR MULTIPLES PART 2 ;
;;2.6;IHS 3P BILLING SYSTEM;**4,9,11,14,21**;NOV 12, 2009;Build 379
;
; IHS/ASDS/LSL - 04/26/01 - V2.4 Patch 9 - NOIS BXX-0401-150085
; Allow resequencing of DX when list contains more than 30 characters.
;
;IHS/SD/SDR - 2.6*14 - ICD10 002F - Added code to populate new .06 field, ICD Indicator
;IHS/SD/SDR - 2.6*14 - HEAT163742 - Fixed issue with sequencing when 'garbage' is entered
;IHS/SD/SDR - 2.6*21 - HEAT197150 - If there were 10+ DXs on a claim it wouldn't sequence them. It was expecting
; there to only be 1-digit sequence numbers in the validation check of the data entered.
;IHS/SD/SDR - 2.6*21 - HEAT220530 - Made change to longer list of billing sequence can be entered; changed from 40 to 55
; chars in DIR call.
;
; *********************************************************************
;
S1 ; Sequence Multiple
K DIR S DIR("B")=1 F ABMX=2:1:ABMZ("NUM") Q:ABMX>ABMZ("NUM") S DIR("B")=DIR("B")_","_ABMX
I DIR("B")=1 G XIT
;S DIR(0)="FO^1:40" ;abm*2.6*21 IHS/SD/SDR HEAT220530
S DIR(0)="FO^1:55" ;abm*2.6*21 IHS/SD/SDR HEAT220530
S DIR("A")="Enter the desired billing sequence"
S DIR("?")="Enter the billing sequence, separated by commas"
S DIR("A",1)=" "
S DIR("A",2)=" If you need to change the current billing order then"
S DIR("A",3)=" enter the sequence numbers above in the desired order"
S DIR("A",4)=" separated by commas."
S DIR("A",5)=" "
S DIR("A",6)=" NOTE: If the billing sequence is different from that noted"
;S DIR("A",7)=" in the file then a Physcian's Attestation is required!" ;abm*2.6*4 NOHEAT
S DIR("A",7)=" in the file then a Physician's Attestation is required!" ;abm*2.6*4 NOHEAT
S DIR("A",8)=" "
D ^DIR K DIR
Q:$D(DIRUT)!$D(DIROUT)
S2 ;
;K ABMX F ABMX=1:1 S ABMX("Y")=$P(Y,",",ABMX) Q:ABMX("Y")="" Q:+ABMX("Y")'>0!(ABMX("Y")'<(ABMZ("NUM")+1))!$D(ABMX(ABMX("Y"))) S ABMX(ABMX("Y"))=ABMX ;abm*2.6*11 HEAT116046
;start new abm*2.6*14 HEAT163742
S ABMCHKFG=0
F ABMX=1:1:$L(Y) D
.S ABMXTEST=$E(Y,ABMX)
.;I '((ABMXTEST=",")!(($A(ABMXTEST)>48)&($A(ABMXTEST)<58))) S ABMCHKFG=1 ;abm*2.6*21 IHS/SD/SDR HEAT197150
.I '((ABMXTEST=",")!(+ABMXTEST=ABMXTEST)) S ABMCHKFG=1 ;abm*2.6*21 IHS/SD/SDR HEAT197150
I ABMCHKFG=1 D G S1
.W !!,"Non-numeric data entered during sequencing. Separate using commas."
.W !,"Please try again"
;end new NOHEAT7
K ABMX F ABMX=1:1 S ABMX("Y")=+$P(Y,",",ABMX) Q:ABMX("Y")="" Q:+ABMX("Y")'>0!(ABMX("Y")'<(ABMZ("NUM")+1))!$D(ABMX(ABMX("Y"))) S ABMX(ABMX("Y"))=ABMX ;abm*2.6*11 HEAT116046
I (ABMZ("NUM")+1)'=ABMX W *7,!!,"ERROR: Invalid input, to re-sequence all sequence numbers must be specified",!," and separated with commas.",! Q
;S DA(1)=ABMP("CDFN"),DIC="^ABMDCLM(DUZ(2),"_DA(1)_","_ABMZ("SUB")_",",DIC(0)="LE" ;abm*2.6*14 ICD10 002F
;K ^ABMDCLM(DUZ(2),DA(1),ABMZ("SUB")) S ^ABMDCLM(DUZ(2),DA(1),ABMZ("SUB"),0)="^9002274.30"_ABMZ("SUB")_"P^^" ;abm*2.6*14 ICD10 002F
;start new code abm*2.6*14 ICD10 002F
S ABMTMP=0
F S ABMTMP=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),ABMZ("SUB"),"C",ABMTMP)) Q:'ABMTMP D
.S ABMTMP2=0
.F S ABMTMP2=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),ABMZ("SUB"),"C",ABMTMP,ABMTMP2)) Q:'ABMTMP2 D
..S DA(1)=ABMP("CDFN")
..S DIK="^ABMDCLM(DUZ(2),"_DA(1)_","_ABMZ("SUB")_","
..S DA=ABMTMP2
..D ^DIK
K ABMTMP,ABMTMP2
D ^XBFMK
;end new code ICD10 002F
;F ABMX=1:1:ABMZ("NUM") S X=$P(ABMZ(ABMX),U,3),DIC("DR")=".02////"_ABMX(ABMX)_";.05////"_$P($G(ABMZ(ABMX)),U,5) S:ABMZ("X")="DINUM" DINUM=X D DR ;abm*2.6*9 HEAT63840
;F ABMX=1:1:ABMZ("NUM") S X=$P(ABMZ(ABMX),U,3),DIC("DR")=".02////"_ABMX(ABMX)_";.03////"_$P($G(ABMZ(ABMX)),U,3)_";.04////"_$P($G(ABMZ(ABMX)),U,5)_";.05////"_$P($G(ABMZ(ABMX)),U,6) S:ABMZ("X")="DINUM" DINUM=X D DR ;abm*2.6*9 HEAT63840 ;abm*2.6*14 ICD10 002F
;start new code abm*2.6*14 ICD10 002F
S DA(1)=ABMP("CDFN")
S DIC="^ABMDCLM(DUZ(2),"_DA(1)_","_ABMZ("SUB")_","
S DIC(0)="LE"
F ABMX=1:1:ABMZ("NUM") D
.S X=$P(ABMZ(ABMX),U,3)
.S DIC("DR")=".02////"_ABMX(ABMX)
.S DIC("DR")=DIC("DR")_";.03////"_$P($G(ABMZ(ABMX)),U,3)_";.04////"_$P($G(ABMZ(ABMX)),U,5)_";.05////"_$P($G(ABMZ(ABMX)),U,6)_";.06////"_$P($G(ABMZ(ABMX)),U,7)
.S:ABMZ("X")="DINUM" DINUM=X
.D DR
;end new code ICD10 002F
Q
;
RES(ABMULT) ;EP - RESET PRIORITIES - X=MULTIPLE
N DIE,DA
S DA(1)=ABMP("CDFN")
S DIE="^ABMDCLM(DUZ(2),DA(1),ABMULT,"
S ABMI=0,ABMCNT=0
F S ABMI=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),ABMULT,"C",ABMI)) Q:'ABMI D
.S DA=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),ABMULT,"C",ABMI,0))
.S ABMCNT=ABMCNT+1
.;S DR=".02///"_ABMCNT ;abm*2.6*14 ICD10 002F
.S DR=".02////"_ABMCNT ;abm*2.6*14 ICD10 002F
.D ^DIE
K ABMI,ABMULT,ABMCNT
Q
;
DR ;DR LINE TAG
S:$P(ABMZ(ABMX),U,4)]"" DIC("DR")=DIC("DR")_";.03////"_$P(ABMZ(ABMX),U,4)
S:$P(ABMZ(ABMX),U,5)]"" DIC("DR")=DIC("DR")_";.04////"_$P(ABMZ(ABMX),U,5)
S:$P(ABMZ(ABMX),U,6)]"" DIC("DR")=DIC("DR")_";.05////"_$P(ABMZ(ABMX),U,6)
S:$P(ABMZ(ABMX),U,7)]"" DIC("DR")=DIC("DR")_";.06////"_$P(ABMZ(ABMX),U,7)
S:$P(ABMZ(ABMX),U,8)]"" DIC("DR")=DIC("DR")_";.07////"_$P(ABMZ(ABMX),U,8)
S:$P(ABMZ(ABMX),U,9)]"" DIC("DR")=DIC("DR")_";.08////"_$P(ABMZ(ABMX),U,9)
S:$P(ABMZ(ABMX),U,10)]"" DIC("DR")=DIC("DR")_";.09////"_$P(ABMZ(ABMX),U,10)
K DD,DO D FILE^DICN
Q
;
AN ;EP for Entering Anesthesia info
Q
;
XIT K ABMX
Q
ABMDEMLA ; IHS/ASDST/DMJ - Edit Utility - FOR MULTIPLES PART 2 ;
+1 ;;2.6;IHS 3P BILLING SYSTEM;**4,9,11,14,21**;NOV 12, 2009;Build 379
+2 ;
+3 ; IHS/ASDS/LSL - 04/26/01 - V2.4 Patch 9 - NOIS BXX-0401-150085
+4 ; Allow resequencing of DX when list contains more than 30 characters.
+5 ;
+6 ;IHS/SD/SDR - 2.6*14 - ICD10 002F - Added code to populate new .06 field, ICD Indicator
+7 ;IHS/SD/SDR - 2.6*14 - HEAT163742 - Fixed issue with sequencing when 'garbage' is entered
+8 ;IHS/SD/SDR - 2.6*21 - HEAT197150 - If there were 10+ DXs on a claim it wouldn't sequence them. It was expecting
+9 ; there to only be 1-digit sequence numbers in the validation check of the data entered.
+10 ;IHS/SD/SDR - 2.6*21 - HEAT220530 - Made change to longer list of billing sequence can be entered; changed from 40 to 55
+11 ; chars in DIR call.
+12 ;
+13 ; *********************************************************************
+14 ;
S1 ; Sequence Multiple
+1 KILL DIR
SET DIR("B")=1
FOR ABMX=2:1:ABMZ("NUM")
IF ABMX>ABMZ("NUM")
QUIT
SET DIR("B")=DIR("B")_","_ABMX
+2 IF DIR("B")=1
GOTO XIT
+3 ;S DIR(0)="FO^1:40" ;abm*2.6*21 IHS/SD/SDR HEAT220530
+4 ;abm*2.6*21 IHS/SD/SDR HEAT220530
SET DIR(0)="FO^1:55"
+5 SET DIR("A")="Enter the desired billing sequence"
+6 SET DIR("?")="Enter the billing sequence, separated by commas"
+7 SET DIR("A",1)=" "
+8 SET DIR("A",2)=" If you need to change the current billing order then"
+9 SET DIR("A",3)=" enter the sequence numbers above in the desired order"
+10 SET DIR("A",4)=" separated by commas."
+11 SET DIR("A",5)=" "
+12 SET DIR("A",6)=" NOTE: If the billing sequence is different from that noted"
+13 ;S DIR("A",7)=" in the file then a Physcian's Attestation is required!" ;abm*2.6*4 NOHEAT
+14 ;abm*2.6*4 NOHEAT
SET DIR("A",7)=" in the file then a Physician's Attestation is required!"
+15 SET DIR("A",8)=" "
+16 DO ^DIR
KILL DIR
+17 IF $DATA(DIRUT)!$DATA(DIROUT)
QUIT
S2 ;
+1 ;K ABMX F ABMX=1:1 S ABMX("Y")=$P(Y,",",ABMX) Q:ABMX("Y")="" Q:+ABMX("Y")'>0!(ABMX("Y")'<(ABMZ("NUM")+1))!$D(ABMX(ABMX("Y"))) S ABMX(ABMX("Y"))=ABMX ;abm*2.6*11 HEAT116046
+2 ;start new abm*2.6*14 HEAT163742
+3 SET ABMCHKFG=0
+4 FOR ABMX=1:1:$LENGTH(Y)
Begin DoDot:1
+5 SET ABMXTEST=$EXTRACT(Y,ABMX)
+6 ;I '((ABMXTEST=",")!(($A(ABMXTEST)>48)&($A(ABMXTEST)<58))) S ABMCHKFG=1 ;abm*2.6*21 IHS/SD/SDR HEAT197150
+7 ;abm*2.6*21 IHS/SD/SDR HEAT197150
IF '((ABMXTEST=",")!(+ABMXTEST=ABMXTEST))
SET ABMCHKFG=1
End DoDot:1
+8 IF ABMCHKFG=1
Begin DoDot:1
+9 WRITE !!,"Non-numeric data entered during sequencing. Separate using commas."
+10 WRITE !,"Please try again"
End DoDot:1
GOTO S1
+11 ;end new NOHEAT7
+12 ;abm*2.6*11 HEAT116046
KILL ABMX
FOR ABMX=1:1
SET ABMX("Y")=+$PIECE(Y,",",ABMX)
IF ABMX("Y")=""
QUIT
IF +ABMX("Y")'>0!(ABMX("Y")'<(ABMZ("NUM")+1))!$DATA(ABMX(ABMX("Y")))
QUIT
SET ABMX(ABMX("Y"))=ABMX
+13 IF (ABMZ("NUM")+1)'=ABMX
WRITE *7,!!,"ERROR: Invalid input, to re-sequence all sequence numbers must be specified",!," and separated with commas.",!
QUIT
+14 ;S DA(1)=ABMP("CDFN"),DIC="^ABMDCLM(DUZ(2),"_DA(1)_","_ABMZ("SUB")_",",DIC(0)="LE" ;abm*2.6*14 ICD10 002F
+15 ;K ^ABMDCLM(DUZ(2),DA(1),ABMZ("SUB")) S ^ABMDCLM(DUZ(2),DA(1),ABMZ("SUB"),0)="^9002274.30"_ABMZ("SUB")_"P^^" ;abm*2.6*14 ICD10 002F
+16 ;start new code abm*2.6*14 ICD10 002F
+17 SET ABMTMP=0
+18 FOR
SET ABMTMP=$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),ABMZ("SUB"),"C",ABMTMP))
IF 'ABMTMP
QUIT
Begin DoDot:1
+19 SET ABMTMP2=0
+20 FOR
SET ABMTMP2=$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),ABMZ("SUB"),"C",ABMTMP,ABMTMP2))
IF 'ABMTMP2
QUIT
Begin DoDot:2
+21 SET DA(1)=ABMP("CDFN")
+22 SET DIK="^ABMDCLM(DUZ(2),"_DA(1)_","_ABMZ("SUB")_","
+23 SET DA=ABMTMP2
+24 DO ^DIK
End DoDot:2
End DoDot:1
+25 KILL ABMTMP,ABMTMP2
+26 DO ^XBFMK
+27 ;end new code ICD10 002F
+28 ;F ABMX=1:1:ABMZ("NUM") S X=$P(ABMZ(ABMX),U,3),DIC("DR")=".02////"_ABMX(ABMX)_";.05////"_$P($G(ABMZ(ABMX)),U,5) S:ABMZ("X")="DINUM" DINUM=X D DR ;abm*2.6*9 HEAT63840
+29 ;F ABMX=1:1:ABMZ("NUM") S X=$P(ABMZ(ABMX),U,3),DIC("DR")=".02////"_ABMX(ABMX)_";.03////"_$P($G(ABMZ(ABMX)),U,3)_";.04////"_$P($G(ABMZ(ABMX)),U,5)_";.05////"_$P($G(ABMZ(ABMX)),U,6) S:ABMZ("X")="DINUM" DINUM=X D DR ;abm*2.6*9 HEAT63840 ;abm*2.6*
14 ICD10 002F
+30 ;start new code abm*2.6*14 ICD10 002F
+31 SET DA(1)=ABMP("CDFN")
+32 SET DIC="^ABMDCLM(DUZ(2),"_DA(1)_","_ABMZ("SUB")_","
+33 SET DIC(0)="LE"
+34 FOR ABMX=1:1:ABMZ("NUM")
Begin DoDot:1
+35 SET X=$PIECE(ABMZ(ABMX),U,3)
+36 SET DIC("DR")=".02////"_ABMX(ABMX)
+37 SET DIC("DR")=DIC("DR")_";.03////"_$PIECE($GET(ABMZ(ABMX)),U,3)_";.04////"_$PIECE($GET(ABMZ(ABMX)),U,5)_";.05////"_$PIECE($GET(ABMZ(ABMX)),U,6)_";.06////"_$PIECE($GET(ABMZ(ABMX)),U,7)
+38 IF ABMZ("X")="DINUM"
SET DINUM=X
+39 DO DR
End DoDot:1
+40 ;end new code ICD10 002F
+41 QUIT
+42 ;
RES(ABMULT) ;EP - RESET PRIORITIES - X=MULTIPLE
+1 NEW DIE,DA
+2 SET DA(1)=ABMP("CDFN")
+3 SET DIE="^ABMDCLM(DUZ(2),DA(1),ABMULT,"
+4 SET ABMI=0
SET ABMCNT=0
+5 FOR
SET ABMI=$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),ABMULT,"C",ABMI))
IF 'ABMI
QUIT
Begin DoDot:1
+6 SET DA=$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),ABMULT,"C",ABMI,0))
+7 SET ABMCNT=ABMCNT+1
+8 ;S DR=".02///"_ABMCNT ;abm*2.6*14 ICD10 002F
+9 ;abm*2.6*14 ICD10 002F
SET DR=".02////"_ABMCNT
+10 DO ^DIE
End DoDot:1
+11 KILL ABMI,ABMULT,ABMCNT
+12 QUIT
+13 ;
DR ;DR LINE TAG
+1 IF $PIECE(ABMZ(ABMX),U,4)]""
SET DIC("DR")=DIC("DR")_";.03////"_$PIECE(ABMZ(ABMX),U,4)
+2 IF $PIECE(ABMZ(ABMX),U,5)]""
SET DIC("DR")=DIC("DR")_";.04////"_$PIECE(ABMZ(ABMX),U,5)
+3 IF $PIECE(ABMZ(ABMX),U,6)]""
SET DIC("DR")=DIC("DR")_";.05////"_$PIECE(ABMZ(ABMX),U,6)
+4 IF $PIECE(ABMZ(ABMX),U,7)]""
SET DIC("DR")=DIC("DR")_";.06////"_$PIECE(ABMZ(ABMX),U,7)
+5 IF $PIECE(ABMZ(ABMX),U,8)]""
SET DIC("DR")=DIC("DR")_";.07////"_$PIECE(ABMZ(ABMX),U,8)
+6 IF $PIECE(ABMZ(ABMX),U,9)]""
SET DIC("DR")=DIC("DR")_";.08////"_$PIECE(ABMZ(ABMX),U,9)
+7 IF $PIECE(ABMZ(ABMX),U,10)]""
SET DIC("DR")=DIC("DR")_";.09////"_$PIECE(ABMZ(ABMX),U,10)
+8 KILL DD,DO
DO FILE^DICN
+9 QUIT
+10 ;
AN ;EP for Entering Anesthesia info
+1 QUIT
+2 ;
XIT KILL ABMX
+1 QUIT
