ABMDEOK1 ; IHS/SD/SDR - Charge Print Order Screen
;;2.6;IHS 3P BILLING SYSTEM;**23**;NOV 12, 2009;Build 427
;
;IHS/SD/SDR 2.6*23 CR9730 New Routine. Added call for new charge print order screen where user can sequence how charges print on claim.
;
; *********************************************************************
;
PRTORD ;EP
K ABMANS
S ABMCMPLT=0 ;flag that they are done
S ABMOUT=0
K ABMP("CHGS"),ABMT
F D Q:ABMCMPLT=1!(+$G(ABMOUT)=1)
.S ABMOUT=0
.D COMPILE
.I $O(ABMP("CHGS",99999),-1)=1 S ABMOUT=1 Q ;there's only one line item so don't do this page
.S ABMCMPLT=0 ;reset before asking the user anything
.I '$D(ABMP("CHGS")) Q ;start over because there was a problem with the print order and it was removed
.D HDR
.D DISPLAY
.D PROMPT ;ask print order
.I +$G(ABMOUT)=1 Q ;user typed '^' at prompt
.I +$G(ABMCFLG)=1 Q ;something was wrong with answer at prompt; start over
.W $$EN^ABMVDF("IOF")
.D REARRANG ;put lines in new order
;
I +$G(ABMOUT)=0 D PAZ^ABMDRUTL
Q
COMPILE ;EP
K ABMT("CK") ;this will be used to verify everything is selected for print order
S ABMLCNT=0
S ABMTCNT=0
F ABMI=21:2:47 D
.D DATACHK
.Q:ABMQUIT=1
.S ABMJ=0
.F S ABMJ=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),ABMI,ABMJ)) Q:'ABMJ D
..S ABMLCNT=+$G(ABMLCNT)+1
..S ABMTCNT=+$G(ABMTCNT)+1
..D GATHER
I $O(ABMT("CK",99999),-1)'=ABMTCNT D DELETE S ABMPOFLG=0 K ABMP("CHGS")
D RESORT
;D DATACHK
Q
DATACHK; EP
S ABMQUIT=0
I ABMI=41 S ABMQUIT=1 ;skip provider multiple
I ((ABMP("VTYP")=998)&("^23^33^35^37^43^"'[("^"_ABMI_"^"))) S ABMQUIT=1 Q ;dental charges only
I ((ABMP("VTYP")=997)&("^23^43^"'[("^"_ABMI_"^"))) S ABMQUIT=1 Q ;pharmacy charges only
I ((ABMP("VTYP")=996)&("^37^"'[("^"_ABMI_"^"))) S ABMQUIT=1 Q ;laboratory charges only
I ((ABMP("VTYP")=995)&("^35^"'[("^"_ABMI_"^"))) S ABMQUIT=1 Q ;radiology charges only
I (($P($G(^DIC(40.7,ABMP("CLN"),0)),U,2)="A3")&("^47^"'[("^"_ABMI_"^"))) S ABMQUIT=1 Q ;ambulance charges only
I (($P($G(^DIC(40.7,ABMP("CLN"),0)),U,2)'="A3")&("^47^"[("^"_ABMI_"^"))) S ABMQUIT=1 Q ;skip ambulance charges
Q
GATHER ;EP
S ABMREC=$G(^ABMDCLM(DUZ(2),ABMP("CDFN"),ABMI,ABMJ,0))
;revenue code
I ABMI=21 S ABMRC=$P(ABMREC,U,3)
I ABMI=25 S ABMRC=$P(ABMREC,U)
I ABMI=45 S ABMRC=$P(ABMREC,U,5)
I (ABMI'=21&(ABMI'=25)&(ABMI'=45)) S ABMRC=$P(ABMREC,U,2)
;check if print order has been done before; if so, use it for ABMLCNT
I ((ABMI=23)&(+$P(ABMREC,U,30)'=0)) S ABMLCNT=+$P(ABMREC,U,30),ABMPOFLG=1
I ((ABMI'=23)&(+$P(ABMREC,U,23)'=0)) S ABMLCNT=+$P(ABMREC,U,23),ABMPOFLG=1
;
S ABMP("CHGS",ABMRC,ABMLCNT)=ABMI_U_ABMJ ;mult and IEN of entry
S $P(ABMP("CHGS",ABMRC,ABMLCNT),U,3)=ABMRC ;rev code
;service code
S ABMCODE=$S(ABMI=25:$P(ABMREC,U,7),1:$P(ABMREC,U)) ;service code (CPT or med or whatever)
I ABMI=23 S ABMSCODE=$$GET1^DIQ(50,ABMCODE,31,"E")
I ABMI=33 S ABMSCODE=$$GET1^DIQ(9999999.31,ABMCODE,".01","E")
I ABMI'=23&(ABMI'=33) S ABMSCODE=$$GET1^DIQ(81,ABMCODE,".01","E")
I ABMI=25,+ABMSCODE=0 S ABMSCODE="*NO CPT*"
I ABMI=45 S ABMSCODE=$P($G(^ABMCM(+ABMREC,0)),U)
I "^27^43^47"[("^"_ABMI_"^") S ABMM1=$P(ABMREC,U,5),ABMM2=$P(ABMREC,U,8),ABMM3=$P(ABMREC,U,9)
S (ABMM1,ABMM2,ABMM3)=""
I ABMI=21 S ABMM1=$P(ABMREC,U,9),ABMM2=$P(ABMREC,U,11),ABMM3=$P(ABMREC,U,12)
I ABMI=23 S ABMM1=$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),ABMI,ABMJ,2)),U,3),ABMM2=$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),ABMI,ABMJ,2)),U,4),ABMM3=$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),ABMI,ABMJ,2)),U,5)
I ABMI=35 S ABMM1=$P(ABMREC,U,5),ABMM2=$P(ABMREC,U,6),ABMM3=$P(ABMREC,U,7)
I ABMI=37 S ABMM1=$P(ABMREC,U,6),ABMM2=$P(ABMREC,U,7),ABMM3=$P(ABMREC,U,8)
I ABMI=39 S ABMM1=$P(ABMREC,U,6),ABMM2=$P(ABMREC,U,14),ABMM3=$P(ABMREC,U,19)
I ABMI=21 S ABMM1=$P(ABMREC,U,9),ABMM2=$P(ABMREC,U,11),ABMM3=$P(ABMREC,U,12)
S ABMSCODE=ABMSCODE_$S(ABMM1'="":"-"_ABMM1,1:"")_$S(ABMM2'="":"-"_ABMM2,1:"")_$S(ABMM3'="":"-"_ABMM3,1:"")
S $P(ABMP("CHGS",ABMRC,ABMLCNT),U,4)=ABMSCODE
;
S ABMCHRG=($S(ABMI=21:$P(ABMREC,U,7),ABMI=25:$P(ABMREC,U,3),ABMI=33:$P(ABMREC,U,8),1:$P(ABMREC,U,4))) ;charge amount
S ABMUNTS=$S(ABMI=21:$P(ABMREC,U,13),ABMI=25:$P(ABMREC,U,2),ABMI=33:$P(ABMREC,U,9),1:$P(ABMREC,U,3))
S $P(ABMP("CHGS",ABMRC,ABMLCNT),U,6)=ABMUNTS*ABMCHRG ;total charges
I ABMI=23 S $P(ABMP("CHGS",ABMRC,ABMLCNT),U,6)=$P(ABMP("CHGS",ABMRC,ABMLCNT),U,6)+$P(ABMREC,U,5)
S $P(ABMP("CHGS",ABMRC,ABMLCNT),U,5)=$S(+$P(ABMP("CHGS",ABMRC,ABMLCNT),U,6)'=0:ABMUNTS,1:0) ;units
;dos
I "^27^33^39^43^47^"[("^"_ABMI_"^") S ABMDOS=$P(ABMREC,U,7)
I "^21^37^"[("^"_ABMI_"^") S ABMDOS=$P(ABMREC,U,5)
I ABMI=23 S ABMDOS=$P(ABMREC,U,14)
I ABMI=25 S ABMDOS=$P(ABMREC,U,4)
I ABMI=35 S ABMDOS=$P(ABMREC,U,9)
I ABMI=45 S ABMDOS=$P(ABMREC,U,2)
I +$G(ABMDOS)=0 S ABMDOS=$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),7)),U) ;default to service date from
S $P(ABMP("CHGS",ABMRC,ABMLCNT),U,7)=ABMDOS
S ABMT("CK",ABMLCNT)=0 ;this will be used to verify that they selected all the lines
Q
RESORT ;
S ABMRC=0,ABMJ=1
F S ABMRC=$O(ABMP("CHGS",ABMRC)) Q:'ABMRC D
.S ABMI=0
.F S ABMI=$O(ABMP("CHGS",ABMRC,ABMI)) Q:'ABMI D
..S ABMT("CHGS",$S(+$G(ABMPOFLG)=1:ABMI,1:ABMJ))=$G(ABMP("CHGS",ABMRC,ABMI))
..S ABMJ=+$G(ABMJ)+1
K ABMP("CHGS")
M ABMP("CHGS")=ABMT("CHGS")
Q
PROMPT ;EP
S ABMDFLG=0
D ^XBFMK
S DIR(0)="FO"
S DIR("A")="Select printing order"
S DIR("?")="Enter all line numbers, separated by commas, in the desired print order"
D ^DIR K DIR
I X="^" S ABMOUT=1 Q ;exit completely if user typed '^'
Q:$D(DIROUT)!$D(DTOUT)!$D(DUOUT)
I $D(DIRUT) D ;user just typed <return> without selecting - use numerical order
.S ABMDFLG=1
.S ABMC1=0
.F S ABMC1=$O(ABMP("CHGS",ABMC1)) Q:'ABMC1 S Y=$S(Y="":ABMC1,1:Y_","_ABMC1)
.S ABMCMPLT=1
S ABMANS=Y
K Y
S ABMCFLG=0
I +$G(ABMANS)=0 S ABMCFLG=1 Q ;there is something non-numeric to start with
F ABMI=1:1:($L(ABMANS,",")) D
.S ABMTEST=+$P(ABMANS,",",ABMI)
.I ABMTEST=0 S ABMCFLG=1 Q ;not numeric or nothing there
.I ABMTEST'?1.3N S ABMCFLG=1 ;must be 1-3 numbers
.I '$D(ABMP("CHGS",ABMTEST)) S ABMCFLG=1 ;not a number in the list of charges
.S ABMT("CK",ABMTEST)=+$G(ABMT("CK",ABMTEST))+1 ;accounted for in selection
.I +$G(ABMCFLG)=1 Q ;don't record the entry
I ABMCFLG=1 Q
D DATACHK2,DATACHK3
I ABMCFLG=0 S ABMCMPLT=1
Q
DATACHK ;EP
S ABMC1=0
S ABMCFLG=0
S ABMC2=0
F S ABMC2=$O(ABMP("CHGS",ABMC2)) Q:'ABMC2 D
.S ABMC3=0
.F S ABMC3=$O(ABMP("CHGS",ABMC2,ABMC3)) Q:'ABMC3 D
..I ABMC3'=(ABMC1+1) S ABMCFLG=1
..S ABMC1=+$G(ABMC1)+1
Q
DATACHK2 ;EP
;verifies every number is accounted for in sequence
S ABMC1=0
S ABMANS1=","_ABMANS_","
F S ABMC1=$O(ABMP("CHGS",ABMC1)) Q:'ABMC1 D
.I ABMANS1'[(","_ABMC1_",") S ABMCFLG=1 ;not an answer selected
Q
DATACHK3 ;EP
S ABMC2=0
F S ABMC2=$O(ABMT("CK",ABMC2)) Q:'ABMC2 D
.I +$G(ABMT("CK",ABMC2))=0 S ABMCFLG=1 ;there's a line that wasn't sequenced
.I +$G(ABMT("CK",ABMC2))>1 S ABMCFLG=1 ;line was selected more than once
I +$G(ABMCFLG)=1 D DELETE K ABMP("CHGS") ;there's a bad entry, delete them all
Q
ADD ;EP
F ABMI=1:1:($L(ABMANS,",")) D
.D ^XBFMK
.S DA(1)=ABMP("CDFN")
.S ABMREC=$G(ABMP("CHGS",ABMI))
.S ABMMULT=$P(ABMREC,U)
.S DA=$P(ABMREC,U,2)
.S DIE="^ABMDCLM("_DUZ(2)_","_DA(1)_","_ABMMULT_","
.S DR=$S(ABMMULT=23:".3",1:".23")_"////"_ABMI
.D ^DIE
Q
DELETE ;EP
S ABMLCNT=0
F S ABMLCNT=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),"PO",ABMLCNT)) Q:'ABMLCNT D
.S ABMI=0
.F S ABMI=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),"PO",ABMLCNT,ABMI)) Q:'ABMI D
..S ABMJ=0
..F S ABMJ=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),"PO",ABMLCNT,ABMI,ABMJ)) Q:'ABMJ D
...D ^XBFMK
...S DA(1)=ABMP("CDFN")
...S ABMMULT=ABMI
...S DA=ABMJ
...S DIE="^ABMDCLM("_DUZ(2)_","_DA(1)_","_ABMMULT_","
...S DR=$S(ABMI=23:".3",1:".23")_"////@"
...D ^DIE
Q
HDR ;EP
W $$EN^ABMVDF("IOF")
W !
D CENTER^ABMUCUTL("* * * CHARGE PRINT ORDER SCREEN * * *")
W !!,"Complete list of charges on claim for "_$$GET1^DIQ(9999999.18,ABMP("INS"),".01","E")_":",!!
W !?5,"Revenue",?31,"Serv",?70,"Total",!
W ?5,"Code Description",?28,"PG",?31,"Code",?54,"DOS",?63,"Units",?70,"Charges",!
F I=1:1:80 W "-"
W !
Q
DISPLAY ;EP
S ABMLCNT=0
F S ABMLCNT=$O(ABMP("CHGS",ABMLCNT)) Q:'ABMLCNT D
.S ABMREC=$G(ABMP("CHGS",ABMLCNT))
.W !?1,$J(ABMLCNT,3)_". "_$P(ABMREC,U,3)_" "_$E($$GET1^DIQ(9999999.72,$P(ABMREC,U,3),"1","E"),1,10) ;rev code and desc
.S ABMI=$P(ABMREC,U)
.S ABMPG="8"_$S(ABMI=21:"B",ABMI=23:"D",ABMI=25:"C",ABMI=27:"A",ABMI=35:"E",ABMI=37:"F",ABMI=43:"H",ABMI=45:"I",ABMI=47:"K",1:"")
.I ABMI=33 S ABMPG="6"
.W ?28,ABMPG ;claim editor page
.W ?31,$P(ABMREC,U,4) ;service code
.W ?54,$$SDTO^ABMDUTL($P(ABMREC,U,7)) ;DOS
.W ?63,$P(ABMREC,U,5) ;units
.W ?69,"$"_$J($FN(($P(ABMREC,U,5)*$P(ABMREC,U,6)),",",2),10) ;total charges
I +$G(ABMDFLG)=1 W !!,"Nothing was selected so it will default to display on screen"
I +$G(ABMPOFLG) W !!,"THIS DISPLAY REFLECTS A PRINT ORDER THAT'S ALREADY BEEN DONE, but can be", !," changed if necessary"
I +$G(ABMCFLG)&($G(ABMANS)'="") W !!?3,"THERE IS AN ISSUE with the print order selected. You entered:",!?3,ABMANS,!!?3,"Please try again."
I +$G(ABMCFLG)&($G(ABMANS)="") W !!?3,"THERE IS AN ISSUE with the print order selected. Please try again."
I +$G(ABMANS)=0 W !!,"NOTE: all lines must be included in the printing order and separated by commas.",!?6,"(i.e., 2,1,4,3)"
Q
REARRANG ;EP
M ABMTEMP("CHGS")=ABMP("CHGS")
K ABMP("CHGS")
F ABMI=1:1:($L(ABMANS,",")) D
.S ABMLN=+$P(ABMANS,",",ABMI)
.S ABMP("CHGS",ABMI)=$G(ABMTEMP("CHGS",ABMLN))
K ABMTEMP
K ABMCFLG,ABMPOFLG,ABMDFLG
W !!, "This is the print order you selected:",!
D DISPLAY
D ^XBFMK
S DIR(0)="Y"
S DIR("A")="Is this the correct order"
D ^DIR K DIR
Q:$D(DIRUT)!$D(DIROUT)!$D(DTOUT)!$D(DUOUT)
I Y<1 S ABMCMPLT=0 Q
W !!?3,"Saving print order"
D ADD
S ABMCMPLT=1
Q
ABMDEOK1 ; IHS/SD/SDR - Charge Print Order Screen
+1 ;;2.6;IHS 3P BILLING SYSTEM;**23**;NOV 12, 2009;Build 427
+2 ;
+3 ;IHS/SD/SDR 2.6*23 CR9730 New Routine. Added call for new charge print order screen where user can sequence how charges print on claim.
+4 ;
+5 ; *********************************************************************
+6 ;
PRTORD ;EP
+1 KILL ABMANS
+2 ;flag that they are done
SET ABMCMPLT=0
+3 SET ABMOUT=0
+4 KILL ABMP("CHGS"),ABMT
+5 FOR
Begin DoDot:1
+6 SET ABMOUT=0
+7 DO COMPILE
+8 ;there's only one line item so don't do this page
IF $ORDER(ABMP("CHGS",99999),-1)=1
SET ABMOUT=1
QUIT
+9 ;reset before asking the user anything
SET ABMCMPLT=0
+10 ;start over because there was a problem with the print order and it was removed
IF '$DATA(ABMP("CHGS"))
QUIT
+11 DO HDR
+12 DO DISPLAY
+13 ;ask print order
DO PROMPT
+14 ;user typed '^' at prompt
IF +$GET(ABMOUT)=1
QUIT
+15 ;something was wrong with answer at prompt; start over
IF +$GET(ABMCFLG)=1
QUIT
+16 WRITE $$EN^ABMVDF("IOF")
+17 ;put lines in new order
DO REARRANG
End DoDot:1
IF ABMCMPLT=1!(+$GET(ABMOUT)=1)
QUIT
+18 ;
+19 IF +$GET(ABMOUT)=0
DO PAZ^ABMDRUTL
+20 QUIT
COMPILE ;EP
+1 ;this will be used to verify everything is selected for print order
KILL ABMT("CK")
+2 SET ABMLCNT=0
+3 SET ABMTCNT=0
+4 FOR ABMI=21:2:47
Begin DoDot:1
+5 DO DATACHK
+6 IF ABMQUIT=1
QUIT
+7 SET ABMJ=0
+8 FOR
SET ABMJ=$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),ABMI,ABMJ))
IF 'ABMJ
QUIT
Begin DoDot:2
+9 SET ABMLCNT=+$GET(ABMLCNT)+1
+10 SET ABMTCNT=+$GET(ABMTCNT)+1
+11 DO GATHER
End DoDot:2
End DoDot:1
+12 IF $ORDER(ABMT("CK",99999),-1)'=ABMTCNT
DO DELETE
SET ABMPOFLG=0
KILL ABMP("CHGS")
+13 DO RESORT
+14 ;D DATACHK
+15 QUIT
DATACHK;
*** ERROR ***
+1 SET ABMQUIT=0
+2 ;skip provider multiple
IF ABMI=41
SET ABMQUIT=1
+3 ;dental charges only
IF ((ABMP("VTYP")=998)&("^23^33^35^37^43^"'[("^"_ABMI_"^")))
SET ABMQUIT=1
QUIT
+4 ;pharmacy charges only
IF ((ABMP("VTYP")=997)&("^23^43^"'[("^"_ABMI_"^")))
SET ABMQUIT=1
QUIT
+5 ;laboratory charges only
IF ((ABMP("VTYP")=996)&("^37^"'[("^"_ABMI_"^")))
SET ABMQUIT=1
QUIT
+6 ;radiology charges only
IF ((ABMP("VTYP")=995)&("^35^"'[("^"_ABMI_"^")))
SET ABMQUIT=1
QUIT
+7 ;ambulance charges only
IF (($PIECE($GET(^DIC(40.7,ABMP("CLN"),0)),U,2)="A3")&("^47^"'[("^"_ABMI_"^")))
SET ABMQUIT=1
QUIT
+8 ;skip ambulance charges
IF (($PIECE($GET(^DIC(40.7,ABMP("CLN"),0)),U,2)'="A3")&("^47^"[("^"_ABMI_"^")))
SET ABMQUIT=1
QUIT
+9 QUIT
GATHER ;EP
+1 SET ABMREC=$GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),ABMI,ABMJ,0))
+2 ;revenue code
+3 IF ABMI=21
SET ABMRC=$PIECE(ABMREC,U,3)
+4 IF ABMI=25
SET ABMRC=$PIECE(ABMREC,U)
+5 IF ABMI=45
SET ABMRC=$PIECE(ABMREC,U,5)
+6 IF (ABMI'=21&(ABMI'=25)&(ABMI'=45))
SET ABMRC=$PIECE(ABMREC,U,2)
+7 ;check if print order has been done before; if so, use it for ABMLCNT
+8 IF ((ABMI=23)&(+$PIECE(ABMREC,U,30)'=0))
SET ABMLCNT=+$PIECE(ABMREC,U,30)
SET ABMPOFLG=1
+9 IF ((ABMI'=23)&(+$PIECE(ABMREC,U,23)'=0))
SET ABMLCNT=+$PIECE(ABMREC,U,23)
SET ABMPOFLG=1
+10 ;
+11 ;mult and IEN of entry
SET ABMP("CHGS",ABMRC,ABMLCNT)=ABMI_U_ABMJ
+12 ;rev code
SET $PIECE(ABMP("CHGS",ABMRC,ABMLCNT),U,3)=ABMRC
+13 ;service code
+14 ;service code (CPT or med or whatever)
SET ABMCODE=$SELECT(ABMI=25:$PIECE(ABMREC,U,7),1:$PIECE(ABMREC,U))
+15 IF ABMI=23
SET ABMSCODE=$$GET1^DIQ(50,ABMCODE,31,"E")
+16 IF ABMI=33
SET ABMSCODE=$$GET1^DIQ(9999999.31,ABMCODE,".01","E")
+17 IF ABMI'=23&(ABMI'=33)
SET ABMSCODE=$$GET1^DIQ(81,ABMCODE,".01","E")
+18 IF ABMI=25
IF +ABMSCODE=0
SET ABMSCODE="*NO CPT*"
+19 IF ABMI=45
SET ABMSCODE=$PIECE($GET(^ABMCM(+ABMREC,0)),U)
+20 IF "^27^43^47"[("^"_ABMI_"^")
SET ABMM1=$PIECE(ABMREC,U,5)
SET ABMM2=$PIECE(ABMREC,U,8)
SET ABMM3=$PIECE(ABMREC,U,9)
+21 SET (ABMM1,ABMM2,ABMM3)=""
+22 IF ABMI=21
SET ABMM1=$PIECE(ABMREC,U,9)
SET ABMM2=$PIECE(ABMREC,U,11)
SET ABMM3=$PIECE(ABMREC,U,12)
+23 IF ABMI=23
SET ABMM1=$PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),ABMI,ABMJ,2)),U,3)
SET ABMM2=$PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),ABMI,ABMJ,2)),U,4)
SET ABMM3=$PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),ABMI,ABMJ,2)),U,5)
+24 IF ABMI=35
SET ABMM1=$PIECE(ABMREC,U,5)
SET ABMM2=$PIECE(ABMREC,U,6)
SET ABMM3=$PIECE(ABMREC,U,7)
+25 IF ABMI=37
SET ABMM1=$PIECE(ABMREC,U,6)
SET ABMM2=$PIECE(ABMREC,U,7)
SET ABMM3=$PIECE(ABMREC,U,8)
+26 IF ABMI=39
SET ABMM1=$PIECE(ABMREC,U,6)
SET ABMM2=$PIECE(ABMREC,U,14)
SET ABMM3=$PIECE(ABMREC,U,19)
+27 IF ABMI=21
SET ABMM1=$PIECE(ABMREC,U,9)
SET ABMM2=$PIECE(ABMREC,U,11)
SET ABMM3=$PIECE(ABMREC,U,12)
+28 SET ABMSCODE=ABMSCODE_$SELECT(ABMM1'="":"-"_ABMM1,1:"")_$SELECT(ABMM2'="":"-"_ABMM2,1:"")_$SELECT(ABMM3'="":"-"_ABMM3,1:"")
+29 SET $PIECE(ABMP("CHGS",ABMRC,ABMLCNT),U,4)=ABMSCODE
+30 ;
+31 ;charge amount
SET ABMCHRG=($SELECT(ABMI=21:$PIECE(ABMREC,U,7),ABMI=25:$PIECE(ABMREC,U,3),ABMI=33:$PIECE(ABMREC,U,8),1:$PIECE(ABMREC,U,4)))
+32 SET ABMUNTS=$SELECT(ABMI=21:$PIECE(ABMREC,U,13),ABMI=25:$PIECE(ABMREC,U,2),ABMI=33:$PIECE(ABMREC,U,9),1:$PIECE(ABMREC,U,3))
+33 ;total charges
SET $PIECE(ABMP("CHGS",ABMRC,ABMLCNT),U,6)=ABMUNTS*ABMCHRG
+34 IF ABMI=23
SET $PIECE(ABMP("CHGS",ABMRC,ABMLCNT),U,6)=$PIECE(ABMP("CHGS",ABMRC,ABMLCNT),U,6)+$PIECE(ABMREC,U,5)
+35 ;units
SET $PIECE(ABMP("CHGS",ABMRC,ABMLCNT),U,5)=$SELECT(+$PIECE(ABMP("CHGS",ABMRC,ABMLCNT),U,6)'=0:ABMUNTS,1:0)
+36 ;dos
+37 IF "^27^33^39^43^47^"[("^"_ABMI_"^")
SET ABMDOS=$PIECE(ABMREC,U,7)
+38 IF "^21^37^"[("^"_ABMI_"^")
SET ABMDOS=$PIECE(ABMREC,U,5)
+39 IF ABMI=23
SET ABMDOS=$PIECE(ABMREC,U,14)
+40 IF ABMI=25
SET ABMDOS=$PIECE(ABMREC,U,4)
+41 IF ABMI=35
SET ABMDOS=$PIECE(ABMREC,U,9)
+42 IF ABMI=45
SET ABMDOS=$PIECE(ABMREC,U,2)
+43 ;default to service date from
IF +$GET(ABMDOS)=0
SET ABMDOS=$PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),7)),U)
+44 SET $PIECE(ABMP("CHGS",ABMRC,ABMLCNT),U,7)=ABMDOS
+45 ;this will be used to verify that they selected all the lines
SET ABMT("CK",ABMLCNT)=0
+46 QUIT
RESORT ;
+1 SET ABMRC=0
SET ABMJ=1
+2 FOR
SET ABMRC=$ORDER(ABMP("CHGS",ABMRC))
IF 'ABMRC
QUIT
Begin DoDot:1
+3 SET ABMI=0
+4 FOR
SET ABMI=$ORDER(ABMP("CHGS",ABMRC,ABMI))
IF 'ABMI
QUIT
Begin DoDot:2
+5 SET ABMT("CHGS",$SELECT(+$GET(ABMPOFLG)=1:ABMI,1:ABMJ))=$GET(ABMP("CHGS",ABMRC,ABMI))
+6 SET ABMJ=+$GET(ABMJ)+1
End DoDot:2
End DoDot:1
+7 KILL ABMP("CHGS")
+8 MERGE ABMP("CHGS")=ABMT("CHGS")
+9 QUIT
PROMPT ;EP
+1 SET ABMDFLG=0
+2 DO ^XBFMK
+3 SET DIR(0)="FO"
+4 SET DIR("A")="Select printing order"
+5 SET DIR("?")="Enter all line numbers, separated by commas, in the desired print order"
+6 DO ^DIR
KILL DIR
+7 ;exit completely if user typed '^'
IF X="^"
SET ABMOUT=1
QUIT
+8 IF $DATA(DIROUT)!$DATA(DTOUT)!$DATA(DUOUT)
QUIT
+9 ;user just typed <return> without selecting - use numerical order
IF $DATA(DIRUT)
Begin DoDot:1
+10 SET ABMDFLG=1
+11 SET ABMC1=0
+12 FOR
SET ABMC1=$ORDER(ABMP("CHGS",ABMC1))
IF 'ABMC1
QUIT
SET Y=$SELECT(Y="":ABMC1,1:Y_","_ABMC1)
+13 SET ABMCMPLT=1
End DoDot:1
+14 SET ABMANS=Y
+15 KILL Y
+16 SET ABMCFLG=0
+17 ;there is something non-numeric to start with
IF +$GET(ABMANS)=0
SET ABMCFLG=1
QUIT
+18 FOR ABMI=1:1:($LENGTH(ABMANS,","))
Begin DoDot:1
+19 SET ABMTEST=+$PIECE(ABMANS,",",ABMI)
+20 ;not numeric or nothing there
IF ABMTEST=0
SET ABMCFLG=1
QUIT
+21 ;must be 1-3 numbers
IF ABMTEST'?1.3N
SET ABMCFLG=1
+22 ;not a number in the list of charges
IF '$DATA(ABMP("CHGS",ABMTEST))
SET ABMCFLG=1
+23 ;accounted for in selection
SET ABMT("CK",ABMTEST)=+$GET(ABMT("CK",ABMTEST))+1
+24 ;don't record the entry
IF +$GET(ABMCFLG)=1
QUIT
End DoDot:1
+25 IF ABMCFLG=1
QUIT
+26 DO DATACHK2
DO DATACHK3
+27 IF ABMCFLG=0
SET ABMCMPLT=1
+28 QUIT
DATACHK ;EP
+1 SET ABMC1=0
+2 SET ABMCFLG=0
+3 SET ABMC2=0
+4 FOR
SET ABMC2=$ORDER(ABMP("CHGS",ABMC2))
IF 'ABMC2
QUIT
Begin DoDot:1
+5 SET ABMC3=0
+6 FOR
SET ABMC3=$ORDER(ABMP("CHGS",ABMC2,ABMC3))
IF 'ABMC3
QUIT
Begin DoDot:2
+7 IF ABMC3'=(ABMC1+1)
SET ABMCFLG=1
+8 SET ABMC1=+$GET(ABMC1)+1
End DoDot:2
End DoDot:1
+9 QUIT
DATACHK2 ;EP
+1 ;verifies every number is accounted for in sequence
+2 SET ABMC1=0
+3 SET ABMANS1=","_ABMANS_","
+4 FOR
SET ABMC1=$ORDER(ABMP("CHGS",ABMC1))
IF 'ABMC1
QUIT
Begin DoDot:1
+5 ;not an answer selected
IF ABMANS1'[(","_ABMC1_",")
SET ABMCFLG=1
End DoDot:1
+6 QUIT
DATACHK3 ;EP
+1 SET ABMC2=0
+2 FOR
SET ABMC2=$ORDER(ABMT("CK",ABMC2))
IF 'ABMC2
QUIT
Begin DoDot:1
+3 ;there's a line that wasn't sequenced
IF +$GET(ABMT("CK",ABMC2))=0
SET ABMCFLG=1
+4 ;line was selected more than once
IF +$GET(ABMT("CK",ABMC2))>1
SET ABMCFLG=1
End DoDot:1
+5 ;there's a bad entry, delete them all
IF +$GET(ABMCFLG)=1
DO DELETE
KILL ABMP("CHGS")
+6 QUIT
ADD ;EP
+1 FOR ABMI=1:1:($LENGTH(ABMANS,","))
Begin DoDot:1
+2 DO ^XBFMK
+3 SET DA(1)=ABMP("CDFN")
+4 SET ABMREC=$GET(ABMP("CHGS",ABMI))
+5 SET ABMMULT=$PIECE(ABMREC,U)
+6 SET DA=$PIECE(ABMREC,U,2)
+7 SET DIE="^ABMDCLM("_DUZ(2)_","_DA(1)_","_ABMMULT_","
+8 SET DR=$SELECT(ABMMULT=23:".3",1:".23")_"////"_ABMI
+9 DO ^DIE
End DoDot:1
+10 QUIT
DELETE ;EP
+1 SET ABMLCNT=0
+2 FOR
SET ABMLCNT=$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),"PO",ABMLCNT))
IF 'ABMLCNT
QUIT
Begin DoDot:1
+3 SET ABMI=0
+4 FOR
SET ABMI=$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),"PO",ABMLCNT,ABMI))
IF 'ABMI
QUIT
Begin DoDot:2
+5 SET ABMJ=0
+6 FOR
SET ABMJ=$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),"PO",ABMLCNT,ABMI,ABMJ))
IF 'ABMJ
QUIT
Begin DoDot:3
+7 DO ^XBFMK
+8 SET DA(1)=ABMP("CDFN")
+9 SET ABMMULT=ABMI
+10 SET DA=ABMJ
+11 SET DIE="^ABMDCLM("_DUZ(2)_","_DA(1)_","_ABMMULT_","
+12 SET DR=$SELECT(ABMI=23:".3",1:".23")_"////@"
+13 DO ^DIE
End DoDot:3
End DoDot:2
End DoDot:1
+14 QUIT
HDR ;EP
+1 WRITE $$EN^ABMVDF("IOF")
+2 WRITE !
+3 DO CENTER^ABMUCUTL("* * * CHARGE PRINT ORDER SCREEN * * *")
+4 WRITE !!,"Complete list of charges on claim for "_$$GET1^DIQ(9999999.18,ABMP("INS"),".01","E")_":",!!
+5 WRITE !?5,"Revenue",?31,"Serv",?70,"Total",!
+6 WRITE ?5,"Code Description",?28,"PG",?31,"Code",?54,"DOS",?63,"Units",?70,"Charges",!
+7 FOR I=1:1:80
WRITE "-"
+8 WRITE !
+9 QUIT
DISPLAY ;EP
+1 SET ABMLCNT=0
+2 FOR
SET ABMLCNT=$ORDER(ABMP("CHGS",ABMLCNT))
IF 'ABMLCNT
QUIT
Begin DoDot:1
+3 SET ABMREC=$GET(ABMP("CHGS",ABMLCNT))
+4 ;rev code and desc
WRITE !?1,$JUSTIFY(ABMLCNT,3)_". "_$PIECE(ABMREC,U,3)_" "_$EXTRACT($$GET1^DIQ(9999999.72,$PIECE(ABMREC,U,3),"1","E"),1,10)
+5 SET ABMI=$PIECE(ABMREC,U)
+6 SET ABMPG="8"_$SELECT(ABMI=21:"B",ABMI=23:"D",ABMI=25:"C",ABMI=27:"A",ABMI=35:"E",ABMI=37:"F",ABMI=43:"H",ABMI=45:"I",ABMI=47:"K",1:"")
+7 IF ABMI=33
SET ABMPG="6"
+8 ;claim editor page
WRITE ?28,ABMPG
+9 ;service code
WRITE ?31,$PIECE(ABMREC,U,4)
+10 ;DOS
WRITE ?54,$$SDTO^ABMDUTL($PIECE(ABMREC,U,7))
+11 ;units
WRITE ?63,$PIECE(ABMREC,U,5)
+12 ;total charges
WRITE ?69,"$"_$JUSTIFY($FNUMBER(($PIECE(ABMREC,U,5)*$PIECE(ABMREC,U,6)),",",2),10)
End DoDot:1
+13 IF +$GET(ABMDFLG)=1
WRITE !!,"Nothing was selected so it will default to display on screen"
+14 IF +$GET(ABMPOFLG)
WRITE !!,"THIS DISPLAY REFLECTS A PRINT ORDER THAT'S ALREADY BEEN DONE, but can be",
