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

ABMDREEX.m

Go to the documentation of this file. 
  1. ABMDREEX ; IHS/SD/SDR - Re-Create batch of Selected Bills ;    
  1.  ;;2.6;IHS Third Party Billing System;**2,3,4,6,10,14,21**;NOV 12, 2009;Build 379
  1.  ;IHS/SD/SDR 2.6*2-FIXPMS10005 New routine
  1.  ;IHS/SD/SDR 2.6*3-RPMS10005#2 mods to make Submission date of 3P Tx status file work correctly
  1.  ;IHS/SD/SDR 2.6*3-FIXPMS10005 mods to create 1 file for each 1000 bills
  1.  ;IHS/SD/SDR 2.6*4-NOHEAT if create and re-export are done on same day it will have duplicates
  1.  ;IHS/SD/SDR 2.6*6-HEAT28632 <SUBSCR>CHECKBAL+17^ABMDREEX error when parent/satellite present
  1.  ;IHS/SD/SDR 2.6*14-HEAT136160 re-wrote to sort by ins/vloc/vtyp/expmode.  Wasn't creating enough files.  Didn't label all
  1.  ;   changes because there were so many.
  1.  ;IHS/SD/SDR 2.6*21 - Split routine to ABMDREX1.
  1.  ;IHS/SD/SDR 2.6*21 HEAT207484 Made change to stop error <UNDEF>EXPMODE+66^ABMDREEX when no bills meet selected criteria
  1.  ;
  1. EN K ABMT,ABMREX,ABMP,ABMY
  1.  K ^TMP($J,"ABM-D"),^TMP($J,"ABM-D-DUP"),^TMP($J,"D")  ;abm*2.6*4 NOHEAT
  1.  S ABMREX("XMIT")=0
  1.  S ABMT("TOT")="0^0^0"
  1.  W !!,"Re-Print Bills for:"
  1.  K DIR
  1.  S DIR(0)="SO^1:SELECTIVE BILL(S) (Type in the Bills to be included in this                     export.  Grouped by Insurer and Export Mode)"
  1.  S DIR(0)=DIR(0)_";2:FOR 277 - Response of not received for insurance company                        (INACTIVE AT THIS TIME)"
  1.  S DIR(0)=DIR(0)_";3:UNPAID BILLS for an insurer - bill should not have posted                       transactions and should be the original bill amount."
  1.  S DIR("A")="Select Desired Option"
  1.  D ^DIR
  1.  K DIR
  1.  G XIT:$D(DIRUT)!$D(DIROUT),SEL:Y=1,UNPD:Y=3
  1. 277 ;
  1.  W !!!,"INACTIVE AT THIS TIME; functionality will be available in a future patch" H 2 W !
  1.  G EN
  1. SEL ;
  1.  W !!
  1.  K DIC
  1.  S DIC="^ABMDBILL(DUZ(2),"
  1.  S DIC(0)="QZEAM"
  1.  S ABMT=$G(ABMT)+1
  1.  S ABM("E")=$E(ABMT,$L(ABMT))
  1.  S DIC("A")="Select "_ABMT_$S(ABMT>3&(ABMT<21):"th",ABM("E")=1:"st",ABM("E")=2:"nd",ABM("E")=3:"rd",1:"th")_" BILL to Re-Print: "
  1.  ;start new abm*2.6*3 FIXPMS10005
  1.  S DIC("S")="I $P(^(0),U)'=+^(0),""BTCP""[$P(^(0),""^"",4),$P(^ABMDEXP($P(^(0),""^"",6),0),U)[""837"",($$CHECKBAL^ABMDREEX(Y)=1)"
  1.  S:ABMT>1 DIC("S")=DIC("S")_",$P(ABMT(""FORM""),""^"",1)[$P(^(0),""^"",6),($$CHECKBAL^ABMDREEX(Y)=1),(ABMT(""INS"")=$P(^(0),""^"",8)),($P(^(0),U,7)=ABMT(""VTYP""))"
  1.  ;end new FIXPMS10005
  1.  D BENT^ABMDBDIC
  1.  G XIT:$D(DUOUT)!$D(DTOUT)
  1.  I '$G(ABMP("BDFN")) G ZIS:ABMT>1,XIT
  1.  I '$G(ABMP("BDFN")) S ABMT=ABMT-1 G SEL
  1.  S ABMY(ABMP("BDFN"))=""
  1.  G SEL:ABMT>1
  1.  S ABMT("EXP")=$P(^ABMDBILL(DUZ(2),ABMP("BDFN"),0),U,6)
  1.  S ABMT("INS")=$P(^ABMDBILL(DUZ(2),ABMP("BDFN"),0),U,8)
  1.  S ABMT("VTYP")=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),0)),U,7)  ;abm*2.6*3
  1.  S ABMT("FORM")=ABMT("EXP")_"^"_$P($G(^ABMDEXP(ABMT("EXP"),0)),U)
  1.  G SEL
  1. UNPD ;UN-PAID BILLS
  1.  W !!
  1.  K DIR
  1.  S DIR(0)="PO^9999999.18:EQM"
  1.  S DIR("A")="Select Insurer"
  1.  D ^DIR
  1.  K DIR
  1.  G XIT:$D(DIRUT)!$D(DIROUT)
  1.  S ABMREX("SELINS")=+Y
  1. BEGDT K DIR
  1.  S DIR(0)="DO"
  1.  S DIR("A")="Select Beginning Export Date"
  1.  D ^DIR
  1.  K DIR
  1.  ;G XIT:$D(DIRUT)!$D(DIROUT)  ;abm*2.6*3 NOHEAT
  1.  I $D(DIRUT) K ABMREX("SELINS") G UNPD  ;abm*2.6*3 NOHEAT
  1.  G XIT:$D(DIROUT)  ;abm*2.6*3 NOHEAT
  1.  S ABMREX("BEGDT")=+Y
  1. ENDDT K DIR
  1.  S DIR(0)="DO"
  1.  S DIR("A")="Select Ending Export Date"
  1.  D ^DIR
  1.  K DIR
  1.  ;G XIT:$D(DIRUT)!$D(DIROUT)  ;abm*2.6*3 NOHEAT
  1.  I $D(DIRUT) K ABMREX("BEGDT") G BEGDT  ;abm*2.6*3 NOHEAT
  1.  G XIT:$D(DIROUT)  ;abm*2.6*3 NOHEAT
  1.  S ABMREX("ENDDT")=+Y
  1. EXPMODE D ^XBFMK
  1.  S DIC(0)="AEBNQ"
  1.  S DIC="^ABMDEXP("
  1.  S DIC("S")="I $P($G(^ABMDEXP(Y,0)),U)[""837"""
  1.  S DIC("A")="Select Export Mode (leave blank for ALL): "
  1.  D ^DIC
  1.  ;G XIT:$D(DIRUT)!$D(DIROUT)  ;abm*2.6*3 NOHEAT
  1.  G XIT:(X["^^")  ;abm*2.6*3 NOHEAT
  1.  I $D(DUOUT) K ABMREX("ENDDT") G ENDDT  ;abm*2.6*3 NOHEAT
  1.  S ABMREX("SELEXP")=$S(+Y>0:+Y,1:"")  ;they can select all exp modes by leaving prompt blank
  1.  I (ABMREX("BEGDT")>(ABMREX("ENDDT"))) W !!,"Beginning Export Date must be before Ending Export Date" H 1 G UNPD
  1.  ;
  1.  S ABMBDT=(ABMREX("BEGDT")-.5)
  1.  S ABMEDT=(ABMREX("ENDDT")+.999999)
  1.  S (ABMBCNT,ABMTAMT)=0  ;abm*2.6*21 IHS/SD/SDR HEAT207484
  1.  ;start old HEAT136160
  1.  ;S ABMBCNT=0,ABMTAMT=0
  1.  ;S ABMFCNT=1  ;file cnt  ;abm*2.6*3 FIXPMS10005
  1.  ;F  S ABMBDT=$O(^ABMDTXST(DUZ(2),"B",ABMBDT)) Q:(+ABMBDT=0!(ABMBDT>ABMEDT))  D
  1.  ;.S ABMIEN=0
  1.  ;.F  S ABMIEN=$O(^ABMDTXST(DUZ(2),"B",ABMBDT,ABMIEN)) Q:+ABMIEN=0  D
  1.  ;..I $P($G(^ABMDTXST(DUZ(2),ABMIEN,0)),U,4)'=ABMREX("SELINS") Q  ;not our ins
  1.  ;..I ABMREX("SELEXP")'="",($P($G(^ABMDTXST(DUZ(2),ABMIEN,0)),U,2)'=(ABMREX("SELEXP"))) Q  ;they selected one & this isn't it
  1.  ;..I ABMREX("SELEXP")="",($P($G(^ABMDEXP($P($G(^ABMDTXST(DUZ(2),ABMIEN,0)),U,2),0)),U)'[("837")) Q  ;they didn't answer so deflt to all 837s
  1.  ;..S ABMBIEN=0
  1.  ;..S ABMFBCNT=0  ;cnt bills in file ;abm*2.6*3 FIXPMS10005
  1.  ;..F  S ABMBIEN=$O(^ABMDTXST(DUZ(2),ABMIEN,2,ABMBIEN)) Q:+ABMBIEN=0  D
  1.  ;...I $P($G(^ABMDBILL(DUZ(2),ABMBIEN,0)),U,4)="X" Q  ;skip cancelled bills
  1.  ;...S ABMBALCK=$$CHECKBAL(ABMBIEN)
  1.  ;...I ABMBALCK=0 Q  ;has been posted to
  1.  ;...;cnt tot bills & amt
  1.  ;...S ABMBCNT=+$G(ABMBCNT)+1
  1.  ;...S ABMTAMT=+$G(ABMTAMT)+($P($G(^ABMDBILL(DUZ(2),ABMBIEN,2)),U))
  1.  ;...;cnt bills not cancelled or posted to in export
  1.  ;...S ABMREX("CNTS",$P($G(^ABMDTXST(DUZ(2),ABMIEN,0)),U,2),ABMIEN)=+$G(ABMREX("CNTS",$P($G(^ABMDTXST(DUZ(2),ABMIEN,0)),U,2),ABMIEN))+1
  1.  ;...S $P(ABMREX("CNTS",$P($G(^ABMDTXST(DUZ(2),ABMIEN,0)),U,2),ABMIEN),U,2)=+$P($G(ABMREX("CNTS",$P($G(^ABMDTXST(DUZ(2),ABMIEN,0)),U,2),ABMIEN)),U,2)+($P($G(^ABMDBILL(DUZ(2),ABMBIEN,2)),U))
  1.  ;...S ABMREX("EXPS",$P($G(^ABMDTXST(DUZ(2),ABMIEN,0)),U,2),ABMIEN)=""  ;capture what export IENs to do
  1.  ;...;start new abm*2.6*3 FIXPMS10005
  1.  ;...S ^TMP($J,"ABM-D",ABMFCNT,$P($G(^ABMDTXST(DUZ(2),ABMIEN,0)),U,2),ABMIEN,ABMBIEN)=""
  1.  ;...S ^TMP($J,"ABM-D-DUP",ABMBIEN)=+$G(^TMP($J,"ABM-D-DUP",ABMBIEN))+1  ;cnt # of times bill in select exports  ;abm*2.6*3
  1.  ;...S ABMFBCNT=+$G(ABMFBCNT)+1
  1.  ;...I ABMFBCNT>1000 S ABMFCNT=+$G(ABMFCNT)+1,ABMFBCNT=0
  1.  ;...;end new abm*2.6*3 FIXPMS10005
  1.  ;end old start new HEAT136160
  1.  F  S ABMBDT=$O(^ABMDTXST(DUZ(2),"B",ABMBDT)) Q:(+ABMBDT=0!(ABMBDT>ABMEDT))  D
  1.  .S ABMIEN=0
  1.  .F  S ABMIEN=$O(^ABMDTXST(DUZ(2),"B",ABMBDT,ABMIEN)) Q:+ABMIEN=0  D
  1.  ..I $P($G(^ABMDTXST(DUZ(2),ABMIEN,0)),U,4)'=ABMREX("SELINS") Q  ;not our ins
  1.  ..I ABMREX("SELEXP")'="",($P($G(^ABMDTXST(DUZ(2),ABMIEN,0)),U,2)'=(ABMREX("SELEXP"))) Q  ;they selected one & this isn't it
  1.  ..I ABMREX("SELEXP")="",($P($G(^ABMDEXP($P($G(^ABMDTXST(DUZ(2),ABMIEN,0)),U,2),0)),U)'[("837")) Q  ;they didn't answer so deflt to all 837s
  1.  ..S ABMBIEN=0
  1.  ..S ABMFBCNT=0
  1.  ..F  S ABMBIEN=$O(^ABMDTXST(DUZ(2),ABMIEN,2,ABMBIEN)) Q:+ABMBIEN=0  D
  1.  ...I $P($G(^ABMDBILL(DUZ(2),ABMBIEN,0)),U,4)="X" Q  ;skip cancelled bills
  1.  ...S ABMBALCK=$$CHECKBAL(ABMBIEN)
  1.  ...I ABMBALCK=0 Q  ;has been posted to
  1.  ...S ABMVLOC=$P($G(^ABMDBILL(DUZ(2),ABMBIEN,0)),U,3)
  1.  ...S ABMVTYP=$P($G(^ABMDBILL(DUZ(2),ABMBIEN,0)),U,7)
  1.  ...S ABMEXP=$P($G(^ABMDBILL(DUZ(2),ABMBIEN,0)),U,6)
  1.  ...S ABMINS=$P($G(^ABMDBILL(DUZ(2),ABMBIEN,0)),U,8)
  1.  ...S ^TMP($J,"ABM-REEX",ABMINS,ABMVLOC,ABMVTYP,ABMEXP,ABMBIEN)=""  ;use this for export
  1.  ...S ABMBCNT=+$G(ABMBCNT)+1
  1.  ...S ABMTAMT=+$G(ABMTAMT)+$P($G(^ABMDBILL(DUZ(2),ABMBIEN,2)),U)  ;total bill cnt, amt
  1.  ...S ABMREX("CNTS",ABMEXP,ABMIEN)=+$G(ABMREX("CNTS",ABMEXP,ABMIEN))+1
  1.  ...S $P(ABMREX("CNTS",ABMEXP,ABMIEN),U,2)=+$P(ABMREX("CNTS",ABMEXP,ABMIEN),U,2)+$P($G(^ABMDBILL(DUZ(2),ABMBIEN,2)),U)
  1.  ...S ^TMP($J,"ABM-D-DUP",ABMBIEN)=+$G(^TMP($J,"ABM-D-DUP",ABMBIEN))+1
  1.  ;end new HEAT136160
  1.  I ABMBCNT=0 W !!,"No Bills were found that meet the selected criteria" H 3 Q  ;abm*2.6*21 IHS/SD/SDR HEAT207484
  1.  W !!,"A total of "_ABMBCNT_" "_$S(ABMBCNT=1:"bill ",1:"bills ")_"for $"_$J(ABMTAMT,1,2)_" have been located."
  1.  I ABMBCNT>0 D
  1.  .W !?8,"Export mode",?25,"Export Dt/Tm",?50,"#Bills",?60,"Total Amt"
  1.  .S ABMREX("EXP")=0,ABMECNT=0
  1.  .F  S ABMREX("EXP")=$O(ABMREX("CNTS",ABMREX("EXP"))) Q:($G(ABMREX("EXP"))="")  D
  1.  ..S ABMIEN=0
  1.  ..F  S ABMIEN=$O(ABMREX("CNTS",ABMREX("EXP"),ABMIEN)) Q:($G(ABMIEN)="")  D
  1.  ...S ABMECNT=+$G(ABMECNT)+1
  1.  ...W !,?1,ABMECNT,?8,$P(^ABMDEXP(ABMREX("EXP"),0),U),?25,$$CDT^ABMDUTL($P($G(^ABMDTXST(DUZ(2),ABMIEN,0)),U)),?50,+$G(ABMREX("CNTS",ABMREX("EXP"),ABMIEN)),?60,$J(+$P($G(ABMREX("CNTS",ABMREX("EXP"),ABMIEN)),U,2),1,2)
  1. ZIS ;EP
  1.  D ZIS^ABMDREX1  ;abm*2.6*20 IHS/SD/SDR split routine due to size
  1. OUT ;
  1.  D ^%ZISC
  1.  ;
  1. XIT ;
  1.  K ^TMP($J,"D"),^TMP($J,"ABM-D")  ;abm*2.6*3
  1.  K ABMP,ABMY,DIQ,ABMT,ABMREX
  1.  Q
  1. CHECKBAL(ABMBIEN) ;
  1.  S ABMBALCK=0
  1.  S ABMHOLD=DUZ(2)
  1.  S BARSAT=$P($G(^ABMDBILL(DUZ(2),ABMBIEN,0)),U,3)  ;Satellite=3P Visit loc
  1.  S ABMP("DOS")=$P($G(^ABMDBILL(DUZ(2),ABMBIEN,7)),U)
  1.  S BARPAR=0  ;Parent
  1.  ; check site active at DOS to ensure bill added to correct site
  1.  S DA=0
  1.  F  S DA=$O(^BAR(90052.06,DA)) Q:DA'>0  D  Q:BARPAR
  1.  .Q:'$D(^BAR(90052.06,DA,DA))  ;Pos Parent UNDEF Site Parm
  1.  .Q:'$D(^BAR(90052.05,DA,BARSAT))  ;Sat UNDEF Par/Sat
  1.  .Q:+$P($G(^BAR(90052.05,DA,BARSAT,0)),U,5)  ;Par/Sat not usable
  1.  .;Q if sat NOT active at DOS
  1.  .I ABMP("DOS")<$P($G(^BAR(90052.05,DA,BARSAT,0)),U,6) Q
  1.  .;Q if sat became NOT active before DOS
  1.  .I $P($G(^BAR(90052.05,DA,BARSAT,0)),U,7),(ABMP("DOS")>$P($G(^BAR(90052.05,DA,BARSAT,0)),U,7)) Q
  1.  .S BARPAR=$S(BARSAT:$P($G(^BAR(90052.05,DA,BARSAT,0)),U,3),1:"")
  1.  I 'BARPAR Q ABMBALCK  ;No parent defined for satellite
  1.  S DUZ(2)=BARPAR
  1.  S ABMARBIL=$O(^BARBL(DUZ(2),"B",$P($G(^ABMDBILL(ABMHOLD,ABMBIEN,0)),U)))
  1.  S ABMARIEN=$O(^BARBL(DUZ(2),"B",ABMARBIL,0))
  1.  Q:'ABMARIEN ABMBALCK
  1.  S ABMARBAL=$$GET1^DIQ(90050.01,ABMARIEN,15)
  1.  I ABMARBAL'=($P($G(^ABMDBILL(ABMHOLD,ABMBIEN,2)),U)) S ABMBALCK=0
  1.  I ABMARBAL=($P($G(^ABMDBILL(ABMHOLD,ABMBIEN,2)),U)) S ABMBALCK=1
  1.  S DUZ(2)=ABMHOLD
  1.  Q ABMBALCK
  1. CREATEN ;
  1.  S ABMSEQ=1
  1.  S ($P(ABMER(ABMSEQ),U,3),ABMP("EXP"))=ABMEXP
  1.  ;S ABMLOC=$P($G(^AUTTLOC(DUZ(2),0)),U,2)  ;HEAT136160
  1.  S ABMLOC=$P($G(^AUTTLOC(ABMY("LOC"),0)),U,2)  ;HEAT136160
  1.  S ABMY("INS")=$S($G(ABMREX("SELINS")):ABMREX("SELINS"),1:ABMT("INS"))
  1.  S ABMINS("IEN")=ABMY("INS")  ;ins
  1.  S $P(ABMER(ABMSEQ),U)=ABMINS("IEN")  ;abm*2.6*3 FIXPMS10005
  1.  S $P(ABMER(ABMSEQ),U,2)=ABMY("VTYP")  ;abm*2.6*3 FIXPMS10005
  1.  S $P(ABMER(ABMSEQ),U,5)=ABMY("TOT")  ;abm*2.6*3 FIXPMS10005
  1.  ;S ABMITYP=$P($G(^AUTNINS(ABMY("INS"),2)),U)  ;ins typ  ;abm*2.6*10 HEAT73780
  1.  S ABMITYP=$$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,ABMY("INS"),".211","I"),1,"I")  ;ins typ  ;abm*2.6*10 HEAT73780
  1.  ;# forms & tot chgs
  1.  I $G(ABMP("SELINS"))="" S $P(ABMER(ABMSEQ),U,4)=+$G(ABMBCNT)
  1.  I $G(ABMP("SELINS"))'="" S $P(ABMER(ABMSEQ),U,4)=+$G(ABMREX("CNTS",ABMEXP,ABMREX("EDFN")))
  1.  ;start new abm*2.6*3 FIXPMS10005
  1.  D FILE^ABMECS
  1.  ;end new abm*2.6*3 FIXPMS10005
  1.  Q
  1. USEORIG ;
  1.  S ABMP("XMIT")=ABMREX("EDFN")
  1.  S ABMP("EXP")=$P(^ABMDTXST(DUZ(2),ABMP("XMIT"),0),"^",2)
  1.  S ABMP("XRTN")=$P($G(^ABMDEXP(+ABMP("EXP"),0)),"^",4)
  1.  S X=ABMP("XRTN")
  1.  X ^%ZOSF("TEST")
  1.  I '$T D  K ABMP Q
  1.  .W !!,"Routine :",ABMP("XRTN")," not found.Cannot proceed.",!
  1.  .S DIR(0)="E"
  1.  .D ^DIR
  1.  .K DIR
  1.  D @("^"_ABMP("XRTN"))
  1.  K ABMP
  1.  Q
  1. LISTBILL ;
  1.  K ABMY
  1.  S ABMT("BDFN")=0
  1.  F  S ABMT("BDFN")=$O(^ABMDTXST(DUZ(2),ABMREX("EDFN"),2,ABMT("BDFN"))) Q:'ABMT("BDFN")  D
  1.  .I $P($G(^ABMDBILL(DUZ(2),ABMT("BDFN"),0)),U,4)="X" Q  ;skip cancelled bills
  1.  .S ABMBALCK=$$CHECKBAL(ABMT("BDFN"))
  1.  .I ABMBALCK=0 Q
  1.  .S ABMY(ABMT("BDFN"))=""
  1.  Q
  1. BILLSTAT(ABMLOC,ABMBDFN,ABMEXP,ABMSTAT,ABMGCN) ;
  1.  N DIC,DIE,DIR,DA,X,Y,ABMP
  1.  S ABMHOLD=DUZ(2)
  1.  S DUZ(2)=ABMLOC
  1.  S (DA(1),ABMREX("BDFN"))=ABMBDFN
  1.  S DIC="^ABMDBILL(DUZ(2),"_DA(1)_",74,"
  1.  S DIC("P")=$P(^DD(9002274.4,.175,0),U,2)
  1.  S DIC(0)="L"
  1.  S X=ABMEXP
  1.  I $G(ABMREX("BILLSELECT"))'="" S ABMSTAT="F"
  1.  I $G(ABMREX("BATCHSELECT"))'="" S ABMSTAT="S"
  1.  I $G(ABMREX("RECREATE"))'="" S ABMSTAT="C"
  1.  S DIC("DR")=".02////"_ABMSTAT_";.03////"_ABMGCN
  1.  K DD,DO
  1.  D FILE^DICN
  1.  S DUZ(2)=ABMHOLD
  1.  S X="A"  ;deflt bill status to approved
  1.  N DA
  1.  S DA=ABMBDFN
  1.  Q