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

ABMDE0.m

Go to the documentation of this file. 
  1. ABMDE0 ; IHS/ASDST/DMJ - Claim Summary Page ; 10 Nov 2009  2:48 PM
  1.  ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009;Build 133
  1.  ;
  1.  ; IHS/ASDS/LSL - 08/13/2001 - V2.4 Patch 9 NOIS HQW-0798-100082
  1.  ;     If all insurers are unbillable - ask if delete claim
  1.  ;
  1.  ; IHS/SD/SDR - v2.5 p8 - Fix supplied by Carlene McIntyre for
  1.  ;    OmniCell link
  1.  ;
  1.  ; IHS/SD/SDR,TPF - v2.5 p8 - added code for pending status (12)
  1.  ;
  1.  ; IHS/SD/SDR - v2.5 p8 - task 57
  1.  ;   Added code for Rx changes (dt disc. and RTS)
  1.  ;
  1.  ; IHS/SD/SDR - v2.5 p8 - task 5
  1.  ;   Added code for CLIA number to populate on claims if none on
  1.  ;   claim and default is present
  1.  ;
  1.  ; IHS/SD/SDR - v2.5 p9 - per Adrian
  1.  ;    Only display meds check if claim status isn't Uneditable or
  1.  ;    Complete
  1.  ;
  1.  ; IHS/SD/SDR - v2.5 p11 - IM22787
  1.  ;    Modified so future term date for replacement insurer will work
  1.  ;
  1.  ; *********************************************************************
  1.  ;
  1. OPT K ABM,ABMV,ABME,ABMZ
  1.  G XIT:$D(ABMP("DDL")),CONT:$G(ABMP("OPT"))="V"
  1.  W !!?15,"...<< Processing, Claim Error Checks >>..."
  1.  S ABMP("GL")="^ABMDCLM(DUZ(2),"_ABMP("CDFN")_","
  1.  S ABMC("QUE")=2
  1.  S ABMC("E0")=""
  1.  D ERRIN^ABMDECK
  1.  D ^ABMDE1X
  1.  D TPICHECK^ABMDE1
  1.  N I F I=106,107,108,10,102,12,13,6,151,152,153,109 D
  1.  . Q:'$D(ABME(I))
  1.  . S ABMP("JUMP1")=0
  1.  K ABME,ABMC,ABMP("CHK"),ABMP("DDL")
  1.  G CONT:$P($G(ABMP("STATUS")),U)=1
  1.  D PCC
  1.  G:$G(ABMNOPCC) XIT
  1.  D ELIG
  1.  G:$G(ABMNOELG) XIT
  1.  S $P(ABMP("STATUS"),U)=1
  1.  D D2^ABMDE8X  ;build array of Rxs from V Med file/23 multiple
  1.  ;this checks to see if drugs are RTS or discontinued
  1.  S ABMRXIEN=0,ABMRXFLG=0
  1.  F  S ABMRXIEN=$O(ABMMEDS(ABMRXIEN)) Q:+ABMRXIEN=0  D  Q:ABMRXFLG=1
  1.  .I $P($G(ABMMEDS(ABMRXIEN)),U,3)'="",('$D(^ABMDCLM(DUZ(2),ABMP("CDFN"),23,"B",ABMRXIEN))) S ABMRXFLG=1
  1.  .I $P($G(ABMMEDS(ABMRXIEN)),U,4)'="",('$D(^ABMDCLM(DUZ(2),ABMP("CDFN"),23,"B",ABMRXIEN))) S ABMRXFLG=1
  1.  I ABMRXFLG=1 D PUTMEDS
  1.  D D2^ABMDE8X
  1.  ;
  1. CONT ; EP
  1.  D OPEN^ABMDTMS(+$G(ABMP("PDFN")),+$G(ABMP("CDFN")))  ;OmniCell call
  1.  D CLIACHK
  1.  D ^ABMDE0X
  1.  W $$EN^ABMVDF("IOF")
  1.  S ABMP("OPT")="VCFNJQ"
  1.  I $P(^ABMDCLM(DUZ(2),ABMP("CDFN"),0),U,4)="U"!($P(^ABMDCLM(DUZ(2),ABMP("CDFN"),0),U,4)="X") D
  1.  . S ABMP("OPT")="VNJQ"
  1.  . S ABMP("DFLT")="Q"
  1.  . S ABMP("VIEWMODE")=1
  1.  D DISP^ABMDE0A
  1.  W !
  1.  I $P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),0)),U,4)="P" D
  1.  .W !
  1.  .W "Pending for "
  1.  .W $P($G(^ABMPSTAT($P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),0)),U,18),0)),U)  ;status
  1.  .W " by "_$P($G(^VA(200,$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),0)),U,19),0)),U,2)  ;new person inits
  1.  .W !
  1.  D SEL^ABMDEOPT
  1.  I "CFV"'[$E(Y) G XIT
  1.  G XIT:$D(DTOUT)!$D(DUOUT)!$D(DIROUT)
  1.  K ABM,ABMZ
  1.  I $E(X)="V" D  G OPT
  1.  . D ^ABMDECK
  1.  . S ABMP("SCRN")=0
  1.  . K DUOUT,DTOUT,DIRUT,DIROUT
  1.  . S ABMP("OPT")="V"
  1.  I $E(X)="C"!($E(X)="A") D ^ABMDEOK G XIT:$D(ABMP("OVER")),OPT
  1.  I $E(X)="F" D  S Y="Q" G XIT
  1.  .D EN^ABMSTAT($G(ABMP("CDFN")))
  1.  .S ABMP("SCRN")=0
  1.  .K DUOUT,DTOUT,DIRUT,DIROUT
  1.  .S ABMP("OPT")="V"
  1.  ;
  1. XIT ;
  1.  I $G(ABMP("JUMP1")) D
  1.  . S ABMP("SCRN")=1
  1.  . K ABMP("JUMP1")
  1.  K ABM,ABMV,ABME,ABMZ
  1.  Q
  1.  ;
  1.  ; *********************************************************************
  1. ELIG ;EP - CHECK ELIGIBILITY
  1.  K ABMNOELG
  1.  W !!?8,"...<< Checking Eligibility Files for Potential Coverage >>...",!!
  1.  D ^ABMDE2E
  1.  N INSGOOD,INS
  1.  S (INSGOOD,INS)=0
  1.  F  S INS=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,INS)) Q:'+INS  D
  1.  . S:$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,INS,0)),U,3)'="U" INSGOOD=1
  1.  I '+INSGOOD D
  1.  . D ^ABMDE0X
  1.  . D DISP^ABMDE0A
  1.  . W !?3,$$EN^ABMVDF("RVN"),"NOTE:",$$EN^ABMVDF("RVF")
  1.  . W " CANNOT OPEN CLAIM - NO ELIGIBILITY FOUND FOR THIS PATIENT.",!
  1.  . D ENT2^ABMDECAN
  1.  . S Y="Q"
  1.  . S ABMNOELG=1
  1.  Q
  1. PCC ;check pcc primary visit         
  1.  K ABMNOPCC
  1.  Q:'$D(^ABMDCLM(DUZ(2),ABMP("CDFN"),11,"AC","P"))
  1.  N I
  1.  S I=0
  1.  F  S I=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),11,"AC","P",I)) Q:'I  D
  1.  .Q:$P($G(^AUPNVSIT(I,0)),"^",11)
  1.  .S ABMPRI=I
  1.  Q:$G(ABMPRI)
  1.  D ^ABMDE0X
  1.  D DISP^ABMDE0A
  1.  W !?3,$$EN^ABMVDF("RVN"),"NOTE:",$$EN^ABMVDF("RVF")
  1.  W " THE PRIMARY PCC VISIT FOR THIS CLAIM HAS BEEN DELETED.",!
  1.  D ENT2^ABMDECAN
  1.  S Y="Q"
  1.  S ABMNOPCC=1
  1.  Q
  1. PUTMEDS ;
  1.  I $P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),0)),U,4)="C"!($P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),0)),U,4)="U") Q
  1.  W !!,"             * * * * * * M E D I C A T I O N  A L E R T * * * * * *"
  1.  W !!
  1.  K DD,DO,DIE,DIC,DIR
  1.  S DIR("A")="DO YOU WISH TO INCLUDE THOSE ENTRIES ON PAGE 8D"
  1.  S DIR("A",1)="MEDICATIONS WITH A 'DATE DISCONTINUED' OR 'RETURN TO STOCK' ENTRY HAVE BEEN"
  1.  S DIR("A",2)="IDENTIFIED."
  1.  S DIR("A",3)=""
  1.  S DIR(0)="Y"
  1.  S DIR("B")="N"
  1.  D ^DIR K DIR
  1.  I Y=1 D
  1.  .S ABMRXFLG=1
  1.  .S ABMVIEN=0
  1.  .F  S ABMVIEN=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),11,ABMVIEN)) Q:+ABMVIEN=0  D
  1.  ..S ABMP("V0")=$G(^AUPNVSIT(ABMVIEN,0))
  1.  ..D ^ABMDVST5 ;they want to include all meds on claim
  1.  K ABMMEDS,ABMRXFLG,ABMVIEN
  1.  Q
  1. CLIACHK ;
  1.  ;reference
  1.  I $P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),9)),U,23)="" D
  1.  .K DIE,DA,DR
  1.  .S DIE="^ABMDCLM(DUZ(2),"
  1.  .S DA=ABMP("CDFN")
  1.  .S DR=".923////"_$P($G(^ABMDPARM(DUZ(2),1,4)),U,12)
  1.  .D ^DIE
  1.  ;in-house
  1.  I $P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),9)),U,22)="" D
  1.  .K DIE,DA,DR
  1.  .S DIE="^ABMDCLM(DUZ(2),"
  1.  .S DA=ABMP("CDFN")
  1.  .S DR=".922////"_$P($G(^ABMDPARM(DUZ(2),1,4)),U,11)
  1.  .D ^DIE
  1.  Q