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

ABMERSND.m

Go to the documentation of this file. 
  1. ABMERSND ; IHS/ASDST/DMJ - RE-SEND A BATCH OF BILLS ELECTRONIC FORMAT ; 
  1.  ;;2.6;IHS Third Party Billing System;**2,6,8**;NOV 12, 2009
  1.  ;Original;DMJ;
  1.  ; IHS/SD/SDR - abm*2.6*2 - 5PMS10005 - Set var for 3P Bill EXPORT NUMBER RE-EXPORT multiple
  1.  ; IHS/SD/SDR - abm*2.6*6 - 5010 - Changes for clearinghouse
  1.  ;
  1. START ;START HERE   
  1.  W !
  1.  S DIC="^ABMDTXST(DUZ(2),"
  1.  S DIC(0)="AEMQ"
  1.  S DIC("S")="I $L($P($G(^(1)),""^"",4))"
  1.  D ^DIC
  1.  K DIC
  1.  Q:Y<0
  1.  S ABMP("XMIT")=+Y
  1.  ;start new code abm*2.6*6 5010
  1. LIST ; EP
  1.  W !!,"Checking...",!
  1.  K ABMT("XLIST")
  1.  K ABMT("CHKLIST")
  1.  S ABMT("XCNT")=0
  1.  S ABMT("XLINE")=1
  1.  S ABMT("SIEN")=$O(^ABMDTXST(DUZ(2),ABMP("XMIT"),3,9999999),-1)  ;look at last entry only
  1.  I ABMT("SIEN")'="" S ABMT("ORIGGCN")=$P($G(^ABMDTXST(DUZ(2),ABMP("XMIT"),3,ABMT("SIEN"),0)),U,2)
  1.  I $G(ABMT("ORIGGCN"))="" S ABMT("ORIGGCN")=$P($G(^ABMDTXST(DUZ(2),ABMP("XMIT"),1)),U,6)
  1.  ;
  1.  S ABMT("XMIT")=0
  1.  F  S ABMT("XMIT")=$O(^ABMDTXST(DUZ(2),"EGCN",ABMT("ORIGGCN"),ABMT("XMIT"))) Q:'+ABMT("XMIT")  D
  1.  .S ABMT("SIEN")=$O(^ABMDTXST(DUZ(2),ABMT("XMIT"),3,9999999),-1)  ;look at last entry only
  1.  .I ABMT("SIEN")'="" S ABMT("GCN")=$P($G(^ABMDTXST(DUZ(2),ABMT("XMIT"),3,ABMT("SIEN"),0)),U,2)
  1.  .I $G(ABMT("GCN"))="" S ABMT("GCN")=$P($G(^ABMDTXST(DUZ(2),ABMT("XMIT"),1)),U,6)
  1.  .Q:(ABMT("GCN")'=ABMT("ORIGGCN"))
  1.  .S ABMT("CHKLIST",ABMT("XMIT"))=1
  1.  .S ABMT("XLIST",ABMT("XLINE"),ABMT("XMIT"),ABMT("SIEN"),ABMT("GCN"))=""
  1.  .S ABMT("GLIST",ABMT("GCN"))=""
  1.  .S ABMT("XCNT")=+$G(ABMT("XCNT"))+1,ABMT("XLINE")=+$G(ABMT("XLINE"))+1
  1.  I '$D(ABMT("XLIST")) D
  1.  .F  S ABMT("XMIT")=$O(^ABMDTXST(DUZ(2),"C",ABMT("ORIGGCN"),ABMT("XMIT"))) Q:'+ABMT("XMIT")
  1.  ..I $G(ABMT("GCN"))="" S ABMT("GCN")=$P($G(^ABMDTXST(DUZ(2),ABMT("XMIT"),1)),U,6)
  1.  ..Q:(ABMT("GCN")'=ABMT("ORIGGCN"))
  1.  ..S ABMT("CHKLIST",ABMT("XMIT"))=1
  1.  ..S ABMT("XLIST",ABMT("XLINE"),ABMT("XMIT"))=""
  1.  ..S ABMT("GLIST",ABMT("GCN"))=""
  1.  .S ABMT("XCNT")=+$G(ABMT("XCNT"))+1,ABMT("XLINE")=+$G(ABMT("XLINE"))+1
  1.  S ABMER("LAST")=+$G(ABMT("XCNT"))  ;abm*2.6*8
  1.  ;
  1.  I +$G(ABMT("XCNT"))>1 D
  1.  .W !,"There are multiple batches associated with your selection."
  1.  .W !!,"Select from the following:",!
  1.  D BATCHLST
  1.  S ABMQUIT=0
  1.  I +$G(ABMT("XCNT"))>1 D
  1.  .K DIR,DIE,DIC,X,Y,DA
  1.  .S DIR(0)="SO^1:All associated batches;2:A single batch entry;3:Reselect export dates;4:Quit"
  1.  .S DIR("A")="Select"
  1.  .D ^DIR K DIR
  1.  .S ABMANS=+Y
  1.  .I ABMANS=1  ;print all entries
  1.  .I ABMANS=2 D  ;select one entry
  1.  ..D BATCHLST
  1.  ..K DIR,DIE,DIC,X,Y,DA
  1.  ..S DIR(0)="NO^1:"_(ABMT("XCNT")-1)
  1.  ..S DIR("A")="Select"
  1.  ..D ^DIR K DIR
  1.  ..I +Y=0 S ABMQUIT=1
  1.  ..S ABMSEL=Y
  1.  .I ABMANS=3 G START  ;start over
  1.  .I ABMANS=4 S ABMQUIT=1 Q  ;quit w/out printing anything
  1.  Q:ABMQUIT
  1.  I $G(ABMANS)=2 D
  1.  .S ABMT("XCNT")=ABMSEL
  1.  .S ABMECHK=0
  1.  .F  S ABMECHK=$O(ABMT("XLIST",ABMECHK)) Q:'ABMECHK  D
  1.  ..I ABMECHK'=ABMSEL K ABMT("XLIST",ABMECHK)
  1.  .M ABMT("XLIST",1)=ABMT("XLIST",ABMSEL)
  1.  .S (ABMER("CNT"),ABMER("LAST"))=1
  1.  ;
  1.  S:+$G(ABMER("LAST"))=0 ABMER("LAST")=(ABMT("XCNT")-1)
  1.  S ABMT("XCNT")=0
  1.  S ABMER("CNT")=0  ;abm*2.6*8
  1.  F  S ABMT("XCNT")=$O(ABMT("XLIST",ABMT("XCNT"))) Q:'ABMT("XCNT")  D
  1.  .S ABMT("XMIT")=0
  1.  .F  S ABMT("XMIT")=$O(ABMT("XLIST",ABMT("XCNT"),ABMT("XMIT"))) Q:'ABMT("XMIT")  D
  1.  ..;I $D(ABMP("XLIST",ABMT("XCNT"),ABMP("XMIT")))<11 D  Q  ;this is for entries created prior to p6 install  ;abm*2.6*8
  1.  ..I $D(ABMP("XLIST",ABMT("XCNT"),ABMT("XMIT")))<11 D  Q  ;this is for entries created prior to p6 install  ;abm*2.6*8
  1.  ...;S ABMP("XMIT")=ABMT("XMIT"),ABMER("CNT")=ABMT("XCNT")  ;abm*2.6*8
  1.  ...S ABMP("XMIT")=ABMT("XMIT"),ABMER("CNT")=+$G(ABMER("CNT"))+1  ;abm*2.6*8
  1.  ...K ABMP("INS")  ;abm*2.6*8
  1.  ...D CRBATCH
  1.  ..S ABMT("SIEN")=0
  1.  ..F  S ABMT("SIEN")=$O(ABMT("XLIST",ABMT("XCNT"),ABMT("XMIT"),ABMT("SIEN"))) Q:'ABMT("SIEN")  D
  1.  ...S ABMT("GCN")=0
  1.  ...F  S ABMT("GCN")=$O(ABMT("XLIST",ABMT("XCNT"),ABMT("XMIT"),ABMT("SIEN"),ABMT("GCN"))) Q:'ABMT("GCN")  D
  1.  ....;S ABMP("XMIT")=ABMT("XMIT"),ABMER("CNT")=ABMT("XCNT")  ;abm*2.6*8
  1.  ....S ABMP("XMIT")=ABMT("XMIT"),ABMER("CNT")=+$G(ABMER("CNT"))+1  ;abm*2.6*8
  1.  ....K ABMP("INS")  ;abm*2.6*8
  1.  ....D CRBATCH
  1.  K ABMP
  1.  K ABME
  1.  K ABMT
  1.  S DIR(0)="E"
  1.  D ^DIR
  1.  K DIR
  1.  Q
  1.  ;end new code 5010
  1. CRBATCH 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.  ;start old code abm*2.6*3 5PMS10005#2
  1.  ;S DIE="^ABMDTXST(DUZ(2),"
  1.  ;S DA=ABMP("XMIT")
  1.  ;S DR=".16///"_$$NSN^ABMERUTL()
  1.  ;D ^DIE
  1.  ;end old code abm*2.6*3 5PMS10005#2
  1.  S ABMREX("RECREATE")=1  ;abm*2.6*2 5PMS10005
  1.  ;D GCNMULT^ABMERUTL("C",1)  ;abm*2.6*3 5PMS10005#2  ;abm*2.6*6 5010
  1.  I ABMER("CNT")=1 D GCNMULT^ABMERUTL("C",1)  ;abm*2.6*3 5PMS10005#2  ;abm*2.6*6 5010
  1.  ;start new code abm*2.6*8
  1.  I ABMER("CNT")>1 D
  1.  .S DA(1)=ABMP("XMIT")
  1.  .S DIC="^ABMDTXST(DUZ(2),"_DA(1)_",3,"
  1.  .S DIC("P")=$P(^DD(9002274.6,3,0),U,2)
  1.  .S DIC(0)="L"
  1.  .D NOW^%DTC
  1.  .S (X,ABMXMTDT)=%
  1.  .S DIC("DR")=".02////"_ABMGCN
  1.  .S DIC("DR")=DIC("DR")_";.03////C"
  1.  .S DIC("DR")=DIC("DR")_";.04////"_DUZ
  1.  .I +$G(ABM("CHIEN"))'=0  S DIC("DR")=DIC("DR")_";.07////"_+$G(ABM("CHIEN"))
  1.  .D ^DIC
  1.  ;end new code abm*2.6*8
  1.  D @("^"_ABMP("XRTN"))
  1.  ;start old code abm*2.6*6 5010
  1.  ;S DIR(0)="E"
  1.  ;D ^DIR
  1.  ;K DIR
  1.  ;K ABMP
  1.  ;end old code abm*2.6*6 5010
  1.  Q
  1.  ;start new code abm*2.6*6 5010
  1. BATCHLST ;
  1.  W !
  1.  S ABME("XCNT")=0
  1.  F  S ABME("XCNT")=$O(ABMP("XLIST",ABME("XCNT"))) Q:'ABME("XCNT")  D
  1.  .S ABMP("XMIT")=0
  1.  .F  S ABMP("XMIT")=$O(ABMP("XLIST",ABME("XCNT"),ABMP("XMIT"))) Q:'ABMP("XMIT")  D
  1.  ..I $D(ABMP("XLIST",ABME("XCNT"),ABMP("XMIT")))<11 D  Q  ;this is for entries created prior to p6 install
  1.  ...S ABMPIT=$P($G(^ABMDTXST(DUZ(2),ABMP("XMIT"),0)),U,3)
  1.  ...S ABMP("ITYP")=$S(ABMPIT="P":"PRIVATE",ABMPIT="D":"MEDICAID",ABMPIT="R":"MEDICARE",ABMPIT="N":"NON-BEN",ABMPIT="W":"WORK.COMP",ABMPIT="C":"CHAMPUS",1:"ALL SOURCES")
  1.  ...W ABME("XCNT"),?3,$$BDT^ABMDUTL($P($G(^ABMDTXST(DUZ(2),ABMP("XMIT"),0)),U)),?23,ABMP("GCN")
  1.  ...W ?30,$P($G(^ABMDEXP($P($G(^ABMDTXST(DUZ(2),ABMP("XMIT"),0)),U,2),0)),U)
  1.  ...W ?47,ABMP("ITYP")
  1.  ...W:$P($G(^ABMDTXST(DUZ(2),ABMP("XMIT"),3,ABMP("SIEN"),0)),U,7) ?59,$P($G(^ABMRECVR($P($G(^ABMDTXST(DUZ(2),ABMP("XMIT"),3,ABMP("SIEN"),0)),U,7),0)),U)
  1.  ...W !?23,$P($G(^AUTNINS($P($G(^ABMDTXST(DUZ(2),ABMP("XMIT"),0)),U,4),0)),U)
  1.  ...W ?46,$P($G(^VA(200,$P($G(^ABMDTXST(DUZ(2),ABMP("XMIT"),0)),U,5),0)),U)
  1.  ...W:$P($G(^ABMDTXST(DUZ(2),ABMP("XMIT"),3,ABMP("SIEN"),0)),U,6) ?70,"ST02: ",$$FMT^ABMERUTL($P($G(^ABMDTXST(DUZ(2),ABMP("XMIT"),3,ABMP("SIEN"),0)),U,6),"4NR")
  1.  ...W !
  1.  ..S ABMP("SIEN")=0
  1.  ..F  S ABMP("SIEN")=$O(ABMP("XLIST",ABME("XCNT"),ABMP("XMIT"),ABMP("SIEN"))) Q:'ABMP("SIEN")  D
  1.  ...S ABMP("GCN")=0
  1.  ...F  S ABMP("GCN")=$O(ABMP("XLIST",ABME("XCNT"),ABMP("XMIT"),ABMP("SIEN"),ABMP("GCN"))) Q:'ABMP("GCN")  D
  1.  ....S ABMPIT=$P($G(^ABMDTXST(DUZ(2),ABMP("XMIT"),0)),U,3)
  1.  ....S ABMP("ITYP")=$S(ABMPIT="P":"PRIVATE",ABMPIT="D":"MEDICAID",ABMPIT="R":"MEDICARE",ABMPIT="N":"NON-BEN",ABMPIT="W":"WORK.COMP",ABMPIT="C":"CHAMPUS",1:"ALL SOURCES")
  1.  ....W ABME("XCNT"),?3,$$BDT^ABMDUTL($P($G(^ABMDTXST(DUZ(2),ABMP("XMIT"),0)),U)),?23,ABMP("GCN")
  1.  ....W ?30,$P($G(^ABMDEXP($P($G(^ABMDTXST(DUZ(2),ABMP("XMIT"),0)),U,2),0)),U)
  1.  ....W ?47,ABMP("ITYP")
  1.  ....W:$P($G(^ABMDTXST(DUZ(2),ABMP("XMIT"),3,ABMP("SIEN"),0)),U,7) ?59,$P($G(^ABMRECVR($P($G(^ABMDTXST(DUZ(2),ABMP("XMIT"),3,ABMP("SIEN"),0)),U,7),0)),U)
  1.  ....W !?23,$P($G(^AUTNINS($P($G(^ABMDTXST(DUZ(2),ABMP("XMIT"),0)),U,4),0)),U)
  1.  ....W ?46,$P($G(^VA(200,$P($G(^ABMDTXST(DUZ(2),ABMP("XMIT"),0)),U,5),0)),U)
  1.  ....W:$P($G(^ABMDTXST(DUZ(2),ABMP("XMIT"),3,ABMP("SIEN"),0)),U,6) ?70,"ST02: ",$$FMT^ABMERUTL($P($G(^ABMDTXST(DUZ(2),ABMP("XMIT"),3,ABMP("SIEN"),0)),U,6),"4NR")
  1.  ....W !
  1.  Q
  1.  ;end new code 5010