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

ABMDEOK1.m

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