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

ABMDEADD.m

Go to the documentation of this file. 
  1. ABMDEADD ; IHS/ASDST/DMJ - Add New Claim - Non PCC Option ;  
  1.  ;;2.6;IHS 3P BILLING SYSTEM;**9**;NOV 12, 2009
  1.  ;
  1.  ; IHS/SD/SDR - v2.5 p3 - 2/28/03 - QEA-0702-130030
  1.  ;     Added code for manually entered insurer check
  1.  ; IHS/SD/SDR - v2.5 p9 - IM15913
  1.  ;    Add check for admit/encounter date to be >DOB
  1.  ; IHS/SD/SDR - v2.5 p12 - UFMS
  1.  ;   If user isn't logged into cashiering session they can't do
  1.  ;   this option
  1.  ;
  1.  S U="^" W !
  1. PAT K ABMP,ABM
  1.  ;start new code abm*2.6*9 NOHEAT - ensure UFMS is setup
  1.  I $P($G(^ABMDPARM(DUZ(2),1,4)),U,15)="" D  Q
  1.  .W !!,"* * UFMS SETUP MUST BE DONE BEFORE ANY BILLING FUNCTIONS CAN BE USED! * *",!
  1.  .S DIR(0)="E",DIR("A")="Enter RETURN to Continue" D ^DIR K DIR
  1.  ;end new code
  1.  I $P($G(^ABMDPARM(DUZ(2),1,4)),U,15)=1 D  Q:+$G(ABMUOPNS)=0
  1.  .S ABMUOPNS=$$FINDOPEN^ABMUCUTL(DUZ)
  1.  .I +$G(ABMUOPNS)=0 D  Q
  1.  ..W !!,"* * YOU MUST SIGN IN TO BE ABLE TO PERFORM BILLING FUNCTIONS! * *",!
  1.  ..S DIR(0)="E",DIR("A")="Enter RETURN to Continue" D ^DIR K DIR
  1.  K DIC S DIC="^AUPNPAT(",DIC(0)="QZEAM"
  1.  S DIC("A")="Select PATIENT NAME....: "
  1.  D ^DIC
  1.  I $G(X)=""!$D(DUOUT)!$D(DTOUT) G XIT
  1.  I +Y<1 W *7 G XIT
  1.  S ABMP("PDFN")=+Y
  1.  ;
  1. LOC S ABMP("LDFN")=DUZ(2)
  1.  ;
  1. CLN K DIC S DIC(0)="QEAM",DIC="^DIC(40.7,"
  1.  S DIC("A")="Select CLINIC..........: ",DIC("B")="GENERAL"
  1.  D ^DIC
  1.  I $D(DUOUT)!$D(DTOUT)!$D(DIROUT) G XIT
  1.  I X="" W *7 G CLN
  1.  S ABMP("CLN")=+Y
  1.  ;
  1. VTYP K DIC S DIC(0)="QEAM",DIC="^ABMDVTYP(",DIC("B")="OUTPATIENT"
  1.  S DIC("A")="Select VISIT TYPE......: "
  1.  S DIC("S")="I Y'=121"
  1.  D ^DIC K DIC
  1.  I X="" W *7 G VTYP
  1.  G XIT:$D(DTOUT)!$D(DIROUT)!$D(DUOUT)
  1.  S ABMP("VTYP")=+Y
  1.  ;
  1. EDT ;
  1.  K DIR S DIR(0)="D^"_$P($G(^DPT(ABMP("PDFN"),0)),U,3)_":DT:EX"
  1.  S DIR("A")=$S(ABMP("VTYP")=111!($G(ABMP("BTYP"))=111):"Enter ADMISSION DATE...:",1:"Enter ENCOUNTER DATE...:")
  1.  D ^DIR
  1.  G XIT:$D(DTOUT)!$D(DIROUT)!$D(DUOUT)
  1.  S ABMP("VDT")=+Y
  1.  S:ABMP("VTYP")'=111 ABMP("DDT")=+Y
  1.  ;
  1. CHK ;
  1.  S ABM="" F  S ABM=$O(^ABMDCLM(DUZ(2),"B",ABMP("PDFN"),ABM)) Q:'ABM  D
  1.  .Q:$P($G(^ABMDCLM(DUZ(2),ABM,0)),U,2)'=ABMP("VDT")
  1.  .S ABM(ABM)=""
  1.  .Q:$P(^ABMDCLM(DUZ(2),ABM,0),U,7)'=ABMP("VTYP")
  1.  .I ABMP("VTYP")=111 S ABMDUP=1 Q
  1.  .Q:$P(^ABMDCLM(DUZ(2),ABM,0),U,3)'=ABMP("LDFN")
  1.  .Q:$P(^ABMDCLM(DUZ(2),ABM,0),U,6)'=ABMP("CLN")
  1.  .S ABMDUP=1
  1.  I $G(ABMDUP) G DUP
  1.  I '+$O(ABM(0)) G DDT
  1.  W !!,"The following Claims already exist for this Patient on this date:"
  1.  W !!,"Claim",?8,"Location",?40,"Clinic",?62,"Visit Type",!,"-------------------------------------------------------------------------------"
  1.  S ABM=0 F  S ABM=$O(ABM(ABM)) Q:'ABM  D
  1.  .Q:'$D(^ABMDCLM(DUZ(2),ABM,0))
  1.  .W !,ABM,?8,$E($P(^DIC(4,$P(^ABMDCLM(DUZ(2),ABM,0),U,3),0),U),1,30)
  1.  .W ?40,$E($P(^DIC(40.7,$P(^ABMDCLM(DUZ(2),ABM,0),U,6),0),U),1,20)
  1.  .W ?62,$E($P(^ABMDVTYP($P(^ABMDCLM(DUZ(2),ABM,0),U,7),0),U),1,17)
  1.  W ! K DIR S DIR(0)="Y",DIR("A")="Do you wish to CONTINUE to ADD this Claim" D ^DIR K DIR G XIT:'Y
  1.  ;
  1. DDT I ABMP("VTYP")=111 D  G XIT:$D(DTOUT)!$D(DIROUT)!$D(DUOUT)
  1.  .K DIR S DIR(0)="DA^"_ABMP("VDT")_":DT:EX"
  1.  .S DIR("A")="Enter DISCHARGE DATE...: "
  1.  .D ^DIR
  1.  .S ABMP("DDT")=+Y
  1.  ;
  1. LCHK ;CHECK ELIGIBILITY
  1.  W !!,"Checking eligibility..."
  1.  S ABMVDFN=$G(ABMP("VDFN")),ABMPDFN=ABMP("PDFN"),ABMVDT=ABMP("VDT")
  1.  D ELG^ABMDLCK(ABMVDFN,.ABML,ABMPDFN,ABMVDT)
  1. TST ;
  1.  I '$D(ABML)!($O(ABML(""))>96) D
  1.  .W !!,*7,$$EN^ABMVDF("RVN"),"NOTE:",$$EN^ABMVDF("RVF")
  1.  .W " Patient either has no 3rd Party Resources for the date of the visit or the",!,"location/clinic is not billable for the insuring source.",!
  1.  .K DIR S DIR(0)="Y",DIR("A")="Continue",DIR("B")="NO" D ^DIR K DIR I Y'=1 S ABM("F1")=1 Q
  1.  .S DIC="^AUTNINS(",DIC(0)="AEMQ",DIC("S")="I $P($G(^(1)),""^"",7)=1",DIC("A")="Select INSURER to Bill // " D ^DIC K DIC I Y<0 S ABM("F1")=1 Q
  1.  .S ABM("TYP")=$P($G(^AUTNINS(+Y,2)),U) I ABM("TYP")="" S ABM("F1")=1 W !!,"Insurance type undefined for this insurer.",! Q
  1.  .S ABML(1,+Y)="^^"_ABM("TYP")_"^^^^M"
  1.  .S ABM("F1")=0
  1.  G:'$G(ABM("F1")) ^ABMDEAD2
  1.  ;
  1.  W !!,*7,"Claim ",$$EN^ABMVDF("RVN"),"NOT",$$EN^ABMVDF("RVF")," created.",! H 3
  1. XIT K DIC,ABM,ABMP,ABMX,ABMV,ABME,ABML,AUPNLK("ALL"),ABMDUP
  1.  Q
  1.  ;
  1. DUP W *7,!!,"Claim Number: ",ABM," already exists with the Identifiers entered above!",!?5,"(NOTE: Use the EDIT CLAIM Option to Access Existing Claims)"
  1.  K DIR S DIR(0)="E" D ^DIR K DIR
  1.  G XIT