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

ABMDE2.m

Go to the documentation of this file. 
  1. ABMDE2 ; IHS/ASDST/DMJ - Edit Page 2 - PAYERS ;  
  1.  ;;2.6;IHS 3P BILLING SYSTEM;**6,8,10,21**;NOV 12, 2009;Build 379
  1.  ;
  1.  ;IHS/SD/SDR - 10/29/02 - V2.5 P2 - NHA-0402-180088
  1.  ;    Modified so it would allow the deletion of insurer from page 2 if accident or work related claim.
  1.  ;IHS/SD/SDR - v2.5 p8 - IM15307/IM14092 - Modified to display MSP error on page if applicable
  1.  ;IHS/SD/SDR - v2.5 p8 - task 8 - Added code to display replacment insurer
  1.  ;IHS/SD/SDR - v2.5 p9 - IM19040 - Added ability to delete insurers all the time
  1.  ;IHS/SD/SDR - v2.5 p10 - IM20593 - Changed default for MSP reason to NO MSP ON FILE
  1.  ;
  1.  ;IHS/SD/SDR - 2.6*21 - HEAT131494 - Changed code to populate priority for added insurer.  It wasn't being
  1.  ;  populated so insurer wasn't showing up on display.
  1.  ;IHS/SD/SDR - 2.6*21 - HEAT238757 - Fixed so ADD option shows up all the time, nut just when an accident/employment related claim.
  1.  ;
  1. OPT ;
  1.  K ABM,ABME,ABMV,ABMG
  1.  S ABMZ("NUM")=""
  1.  ;S ABMP("OPT")="DPVNJBQ"  ;abm*2.6*6 NOHEAT
  1.  S ABMP("OPT")="ADPVNJBQ"  ;abm*2.6*6 NOHEAT
  1.  ;I $P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),8)),U,3)!($P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),9)),U)="Y") S ABMP("OPT")="A"_ABMP("OPT")  ;abm*2.6*21 IHS/SD/SDR HEAT238757
  1.  I $D(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,"C",1))=10 D
  1.  .I $O(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,"C",1))="" D
  1.  ..S ABMP("OPT")=$P(ABMP("OPT"),"P")_$P(ABMP("OPT"),"P",2)
  1.  S ABMZ("PG")="1,2,7"
  1.  D DISP
  1.  G XIT:$D(DTOUT)!$D(DUOUT)!$D(DIROUT)
  1.  S:$P(^ABMDCLM(DUZ(2),ABMP("CDFN"),0),U,8)="" ABMP("DFLT")="P"
  1.  I ABMZ("NUM")=0 D
  1.  .S ABMP("DFLT")="Q"
  1.  .S ABMP("OPT")="BQ"
  1.  D:$D(ABMW)=10 ^ABMDWARN
  1.  W !
  1.  D SEL^ABMDEOPT
  1.  G XIT:$D(DTOUT)!$D(DUOUT)!$D(DIROUT)!("VPAD"'[$E(Y))
  1.  S ABM("DO")=$S($E(Y)="C":"^ABMDECK",$E(Y)="V":"V1^ABMDE2A",$E(Y)="A":"A1^ABMDEML",$E(Y)="D":"D1",1:"^ABMDE2P")
  1.  D @ABM("DO")
  1.  G XIT:$D(DTOUT)!$D(DUOUT)!$D(DIROUT)!$D(ABMP("OVER"))
  1.  G OPT
  1.  ;
  1.  ; *********************************************************************
  1. DISP ;
  1.  S ABMZ("TITL")="INSURERS"
  1.  S ABMZ("PG")=2
  1.  I $D(ABMP("DDL")),$Y>(IOSL-9) D  Q:$D(DUOUT)!$D(DTOUT)!$D(DIROUT)  I 1
  1.  . D PAUSE^ABMDE1
  1.  E  D SUM^ABMDE1
  1.  I $P(ABMP("C0"),U,8)="" G INSR
  1.  S ABMP("GL")="^ABMDCLM(DUZ(2),"_ABMP("CDFN")_","
  1.  D ^ABMDE2X
  1.  D ^ABMDE2X1
  1.  ;start old code abm*2.6*8 HEAT34042
  1.  ;W:$D(ABMP("VTYP",999)) ?68,"Prof-Comp"
  1.  ;W !,"To: ",$P(ABMV("X5"),U)
  1.  ;W ?40,"Bill Type...: ",$P(^ABMDCLM(DUZ(2),ABMP("CDFN"),0),"^",12)
  1.  ;W:$D(ABMP("VTYP",999)) ?68,"========="
  1.  ;W !?4,$P(ABMV("X5"),U,2)
  1.  ;W ?40,"Proc. Code..: ",$S($P(ABMV("X6"),U,2)="C":"CPT4",$P(ABMV("X6"),U,2)="A":"ADA",1:"ICD9")
  1.  ;I $D(ABMP("VTYP",999)) D
  1.  ;.I '$D(ABMP("FLAT")) D  Q
  1.  ;..W ?68,$S($P(ABMV("X6"),U,2)="C":"CPT4",$P(ABMV("X6"),U,2)="A":"ADA",1:"ICD9")
  1.  ;.W ?68,$S($P(ABMP("FLAT"),U,5)="C":"CPT4",$P(ABMP("FLAT"),U,5)="A":"ADA",1:"ICD9")
  1.  ;W !?4,$P(ABMV("X5"),U,3)
  1.  ;W ?40,"Export Mode.: "
  1.  ;I +ABMV("X6") W $P($G(^ABMDEXP(+ABMV("X6"),0)),U)
  1.  ;W:$G(ABMP("VTYP",999)) ?68,$P(^ABMDEXP(ABMP("VTYP",999),0),U)
  1.  ;W !?4,$P(ABMV("X5"),U,4)
  1.  ;W ?40,"Flat Rate...: ",$S(+$P(ABMV("X6"),U,5):$J($P(ABMV("X6"),U,5),4,2),1:"N/A")
  1.  ;W:$D(ABMP("VTYP",999)) ?68,$S('$D(ABMP("FLAT")):"N/A",$P(ABMP("FLAT"),U,4)]"":$J($P(ABMP("FLAT"),U,4),4,2),1:"N/A")
  1.  ;end old code start new code HEAT34042
  1.  I $P(ABMV("X6"),U,6)="Y" D
  1.  .W:$D(ABMP("VTYP",999)) ?68,"Prof-Comp"
  1.  .W !,"To: ",$P(ABMV("X5"),U)
  1.  .W ?40,"Bill Type...: ",$P(^ABMDCLM(DUZ(2),ABMP("CDFN"),0),"^",12)
  1.  .W:$D(ABMP("VTYP",999)) ?68,"========="
  1.  .W !?4,$P(ABMV("X5"),U,2)
  1.  .;W ?40,"Proc. Code..: ",$S($P(ABMV("X6"),U,2)="C":"CPT4",$P(ABMV("X6"),U,2)="A":"ADA",1:"ICD9")  ;abm*2.6*10 ICD10 002D
  1.  .W ?40,"Proc. Code..: ",$S($P(ABMV("X6"),U,2)="C":"CPT4",$P(ABMV("X6"),U,2)="A":"ADA",1:"ICD")  ;abm*2.6*10 ICD10 002D
  1.  .I $D(ABMP("VTYP",999)) D
  1.  ..I '$D(ABMP("FLAT")) D  Q
  1.  ...;W ?68,$S($P(ABMV("X6"),U,2)="C":"CPT4",$P(ABMV("X6"),U,2)="A":"ADA",1:"ICD9")  ;abm*2.6*10 ICD10 002D
  1.  ...W ?68,$S($P(ABMV("X6"),U,2)="C":"CPT4",$P(ABMV("X6"),U,2)="A":"ADA",1:"ICD")  ;abm*2.6*10 ICD10 002D
  1.  ..;W ?68,$S($P(ABMP("FLAT"),U,5)="C":"CPT4",$P(ABMP("FLAT"),U,5)="A":"ADA",1:"ICD9")  ;abm*2.6*10 ICD10 002D
  1.  ..W ?68,$S($P(ABMP("FLAT"),U,5)="C":"CPT4",$P(ABMP("FLAT"),U,5)="A":"ADA",1:"ICD")  ;abm*2.6*10 ICD10 002D
  1.  .W !?4,$P(ABMV("X5"),U,3)
  1.  .W ?40,"Export Mode.: "
  1.  .I +ABMV("X6") W $P($G(^ABMDEXP(+ABMV("X6"),0)),U)
  1.  .W:$G(ABMP("VTYP",999)) ?68,$P(^ABMDEXP(ABMP("VTYP",999),0),U)
  1.  .W !?4,$P(ABMV("X5"),U,4)
  1.  .W ?40,"Flat Rate...: ",$S(+$P(ABMV("X6"),U,5):$J($P(ABMV("X6"),U,5),4,2),1:"N/A")
  1.  .W:$D(ABMP("VTYP",999)) ?68,$S('$D(ABMP("FLAT")):"N/A",$P(ABMP("FLAT"),U,4)]"":$J($P(ABMP("FLAT"),U,4),4,2),1:"N/A")
  1.  I ($P(ABMV("X6"),U,6)="")!($P(ABMV("X6"),U,6)="N") D  ;if null or NO
  1.  .W:$D(ABMP("VTYP",999)) ?54,"Prof-Comp"
  1.  .W !,"To: ",$P(ABMV("X5"),U)
  1.  .W:'$D(ABMP("VTYP",999)) ?40,"Bill Type...: ",$P(^ABMDCLM(DUZ(2),ABMP("CDFN"),0),"^",12)
  1.  .W:$D(ABMP("VTYP",999)) ?54,"========="
  1.  .W !?4,$P(ABMV("X5"),U,2)
  1.  .;W:'$D(ABMP("VTYP",999)) ?40,"Proc. Code..: ",$S($P(ABMV("X6"),U,2)="C":"CPT4",$P(ABMV("X6"),U,2)="A":"ADA",1:"ICD9")  ;abm*2.6*10 ICD10 002D
  1.  .W:'$D(ABMP("VTYP",999)) ?40,"Proc. Code..: ",$S($P(ABMV("X6"),U,2)="C":"CPT4",$P(ABMV("X6"),U,2)="A":"ADA",1:"ICD")  ;abm*2.6*10 ICD10 002D
  1.  .I $D(ABMP("VTYP",999)) D
  1.  ..I '$D(ABMP("FLAT")) D  Q
  1.  ...;W ?40,"Proc. Code..: ",$S($P(ABMV("X6"),U,2)="C":"CPT4",$P(ABMV("X6"),U,2)="A":"ADA",1:"ICD9")  ;abm*2.6*10 ICD10 002D
  1.  ...W ?40,"Proc. Code..: ",$S($P(ABMV("X6"),U,2)="C":"CPT4",$P(ABMV("X6"),U,2)="A":"ADA",1:"ICD")  ;abm*2.6*10 ICD10 002D
  1.  ..;W ?40,"Proc. Code..: ",$S($P(ABMP("FLAT"),U,5)="C":"CPT4",$P(ABMP("FLAT"),U,5)="A":"ADA",1:"ICD9")  ;abm*2.6*10 ICD10 002D
  1.  ..W ?40,"Proc. Code..: ",$S($P(ABMP("FLAT"),U,5)="C":"CPT4",$P(ABMP("FLAT"),U,5)="A":"ADA",1:"ICD")  ;abm*2.6*10 ICD10 002D
  1.  .W !?4,$P(ABMV("X5"),U,3)
  1.  .I '$D(ABMP("VTYP",999)) W ?40,"Export Mode.: " I +ABMV("X6") W $P($G(^ABMDEXP(+ABMV("X6"),0)),U)
  1.  .I $G(ABMP("VTYP",999)) W ?40,"Export Mode.: ",$P(^ABMDEXP(ABMP("VTYP",999),0),U)
  1.  .W !?4,$P(ABMV("X5"),U,4)
  1.  .W:'$D(ABMP("VTYP",999)) ?40,"Flat Rate...: ",$S(+$P(ABMV("X6"),U,5):$J($P(ABMV("X6"),U,5),4,2),1:"N/A")
  1.  .W:$D(ABMP("VTYP",999)) ?40,"Flat Rate...: ",$S('$D(ABMP("FLAT")):"N/A",$P(ABMP("FLAT"),U,4)]"":$J($P(ABMP("FLAT"),U,4),4,2),1:"N/A")
  1.  ;end new code HEAT34042
  1.  S ABMX=""
  1.  S $P(ABMX,".",80)=""
  1.  W !,ABMX,!
  1.  I $D(^AUPNMSP("C",ABMP("PDFN"))) D
  1.  .K ABMMSP,ABMFLAG,ABMMSPSV
  1.  .; get correct entry based on visit date
  1.  .S ABMMSP=9999999,ABMFLAG="",ABMMSPSV=9999999
  1.  .F  S ABMMSP=$O(^AUPNMSP("C",ABMP("PDFN"),ABMMSP),-1) Q:ABMMSP=""  D  Q:ABMFLAG=1
  1.  ..I $G(ABMMSPSV)="" S ABMMSPSV=ABMMSP
  1.  ..I (ABMP("VDT")<ABMMSPSV&(ABMP("VDT")>ABMMSP))!(ABMMSP=ABMP("VDT")) S ABMMSPSV=$O(^AUPNMSP("C",ABMP("PDFN"),ABMMSP,0)),ABMFLAG=1 Q
  1.  ..I ABMP("VDT")=ABMMSP S ABMFLAG=1 Q
  1.  ..S ABMMSPSV=ABMMSP
  1.  .; write the entry with date
  1.  .I ABMFLAG=1 D
  1.  ..K %DT  ;abm*2.6*8
  1.  ..S Y=ABMMSP
  1.  ..D DD^%DT
  1.  ..S ABMMSPDT=Y
  1.  ..K %DT  ;abm*2.6*8
  1.  ..S ABMMSPRS=$S($G(ABMMSPSV)="":"NO REASON ENTERED",$P($G(^AUPNMSP(ABMMSPSV,0)),U,4)'="":$P($G(^AUPNMSP(ABMMSPSV,0)),U,4),1:"NO REASON ENTERED")
  1.  ..W "MSP STATUS AS OF "_ABMMSPDT_": "
  1.  ..I $G(ABMMSPSV)'="",$P($G(^AUPNMSP(ABMMSPSV,0)),U,3)["Y" W "["_ABMMSPRS_"]-"_$$GET1^DIQ(9000037,ABMMSPSV,.04)
  1.  ..E  W "NOT MSP ELIGIBLE"
  1.  ..W !,ABMX,!
  1.  .K ABMFLAG,ABMMSPSV
  1.  K ABMX
  1.  K ABMMSPDT
  1.  ;
  1. INSR ; Insurer Info
  1.  S ABMZ("SUB")=13
  1.  S ABMZ("DR")=";.03////P"
  1.  S ABMZ("ITEM")="Payer"
  1.  S ABMZ("DIC")="^AUTNINS("
  1.  S ABMZ("X")="X"
  1.  I $Y>(IOSL-8) D PAUSE^ABMDE1 Q:$D(DUOUT)!$D(DTOUT)!$D(DIROUT)
  1.  D HD
  1.  G LOOP
  1.  ;
  1.  ;**********************************************************************
  1. HD ;
  1.  W !?13,"BILLING ENTITY",?39,"STATUS",?52,"POLICY HOLDER"
  1.  W !,?5,"==============================",?37,"==========",?49,"=============================="
  1.  Q
  1.  ;
  1.  ; *********************************************************************
  1. LOOP ;LOOP HERE
  1.  S (ABMZ("LNUM"),ABMZ("NUM"),ABMZ(1),ABMZ("UNBILL"))=0
  1.  S ABM=""
  1.  F ABM("I")=1:1 S ABM=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,"C",ABM)) Q:'ABM  D
  1.  .S ABM("XIEN")=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,"C",ABM,""))
  1.  .S ABM("X")=$P(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,ABM("XIEN"),0),U)
  1.  .D INS
  1.  ;S ABMZ("DR2")=";.02////"_(ABMZ("LNUM")+1)  ;abm*2.6*21 IHS/SD/SDR HEAT131494
  1.  S ABMZ("DR")=ABMZ("DR")_";.02////"_(ABMZ("LNUM")+1)  ;abm*2.6*21 IHS/SD/SDR HEAT131494
  1.  I ABMZ("NUM")=0 W *7,!?5,"*** ERROR: No "_ABMZ("ITEM")_" Exists, at Least One is Required! ***",!
  1.  K ABME
  1.  S ABME("CONT")=""
  1.  S ABM("E")=0
  1.  F  S ABM("E")=$O(ABMG(ABM("E"))) Q:'ABM("E")  D
  1.  . S ABME(ABM("E"))=ABMG(ABM("E"))
  1.  D ^ABMDERR
  1.  K ABME("CONT")
  1.  Q
  1.  ;
  1.  ; *********************************************************************
  1. INS ;
  1.  Q:'$D(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,ABM("XIEN"),0))
  1.  Q:$P(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,ABM("XIEN"),0),U,3)=""
  1.  S ABMZ("NUM")=ABM("I")
  1.  S ABM("X0")=^ABMDCLM(DUZ(2),ABMP("CDFN"),13,ABM("XIEN"),0)
  1.  S:ABMZ("LNUM")<$P(ABM("X0"),U,2) ABMZ("LNUM")=$P(ABM("X0"),U,2)
  1.  I $Y>(IOSL-5) D PAUSE^ABMDE1 Q:$D(DUOUT)!$D(DTOUT)!$D(DIROUT)  D HD
  1.  I $P(ABM("X0"),U,3)="C" D
  1.  .S ABMZ("UNBILL")=ABMZ("UNBILL")+1
  1.  .S ABMZ("UNBILL",ABM("I"))=""
  1.  S ABMZ(ABM("I"))=$P(^AUTNINS(ABM("X"),0),U)_U_ABM("X")_U_ABM("XIEN")_U_$P(ABM("X0"),U,3,9)
  1.  S Y=ABM("X")
  1.  S ABMP("GL")="^ABMDCLM(DUZ(2),"_ABMP("CDFN")_","
  1.  D SEL^ABMDE2X
  1.  S ABM("Y0")=""
  1.  S ABM("Y")=$P(ABM("X0"),U,3)
  1.  I ABM("Y")]"" D
  1.  .S ABM("Y0")=$P(^DD(9002274.3013,.03,0),U,3)
  1.  .S ABM("Y0")=$P($P(ABM("Y0"),ABM("Y")_":",2),";",1)
  1.  W !,"[",ABM("I"),"]"
  1.  I +$P(ABMV("X1"),U)=$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,$P(ABMZ(ABM("I")),U,3),0)),U),($P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,$P(ABMZ(ABM("I")),U,3),0)),U,11)'="") D
  1.  .W ?4,"*"
  1.  .W $P($G(^AUTNINS($P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,$P(ABMZ(ABM("I")),U,3),0)),U,11),0)),U)
  1.  E  W ?5,$P(ABMZ(ABM("I")),U)
  1.  W ?37,ABM("Y0")
  1.  W ?49,$P($P(ABMV("X2"),U),";",2)
  1.  I ABM("Y")="I" S ABM("E")=0 F  S ABM("E")=$O(ABME(ABM("E"))) Q:'ABM("E")  S ABMG(ABM("E"))=ABME(ABM("E"))
  1.  ;S ABM("PRI")=$S($P($G(^AUTNINS(ABM("X"),2)),U)="D":4,"MR"[$P($G(^(2)),U):3,$P($G(^(2)),U)="H":2,1:1)  ;abm*2.6*10 HEAT73780
  1.  S ABMITYP=$$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,ABM("X"),".211","I"),1,"I")  ;abm*2.6*10 HEAT73780
  1.  S ABM("PRI")=$S(ABMITYP="D":4,"MR"[ABMITYP:3,ABMITYP="H":2,1:1)  ;abm*2.6*10 HEAT73780
  1.  S ABM(ABM("PRI"))=""
  1.  Q
  1.  ;
  1. D1 ;EP - Delete Insurer Multiple on claim
  1.  I +$E(Y,2,3)>0&(+$E(Y,2,3)<(ABMZ("NUM")+1)) S Y=+$E(Y,2,3) G D2
  1.  I ABMZ("NUM")=1 S Y=1 G D2
  1.  I ABMZ("NUM")<1 D  G DXIT
  1.  .W !,"There is no ",ABMZ("ITEM")," to delete."
  1.  .H 3
  1.  K DIR S DIR(0)="NO^1:"_ABMZ("NUM")_":0"
  1.  S DIR("?")="Enter the Sequence Number of "_ABMZ("ITEM")_" to Delete"
  1.  S DIR("A")="Sequence Number to DELETE"
  1.  D ^DIR
  1.  K DIR
  1.  G DXIT:$D(DTOUT)!$D(DUOUT)!$D(DIROUT)!(Y'>0)
  1. D2 I ABMZ("NUM")=1 W !,"Cannot delete only insurer on claim!" H 1 Q
  1.  W ! S ABMX("ANS")=+Y K DIR S DIR(0)="YO"
  1.  I $P(ABMZ(ABMX("ANS")),U,4)="I" W !,"Cannot delete active insurer!" H 1 Q
  1.  S DIR("A")="Do you wish "_$P(ABMZ(ABMX("ANS")),U,1)_" DELETED"
  1.  D ^DIR K DIR
  1.  Q:$D(DTOUT)!$D(DUOUT)!$D(DIROUT)
  1. D3 I Y=1 D
  1.  .S DA(1)=ABMP("CDFN")
  1.  .S DA=$P(ABMZ(ABMX("ANS")),U,3)
  1.  .S DIK="^ABMDCLM(DUZ(2),"_DA(1)_","_ABMZ("SUB")_","
  1.  .D ^DIK
  1. DXIT K ABMX
  1.  Q
  1. XIT K ABM,ABMG
  1.  Q