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

AZAXSND.m

Go to the documentation of this file. 
  1. AZAXSND ; IHS/PHXAO/AEF - Re-send several AZ Medicaid batches to AHCCCS  
  1.  ;;1.0;ANNE'S SPECIAL ROUTINES;;MAR 19, 2004
  1.  ;;
  1. DESC ;
  1.  ;;
  1.  ;;This routine contains code from routines ABMERSND and ABMEF10 and
  1.  ;;is used to gather up bills from more than one batch and re-create an
  1.  ;;EMC file for submission to AHCCCS.
  1.  ;;
  1.  ;;Only batches with an export of UB-92-E V4 and Insurer of Arizona
  1.  ;;Medicaid can be selected.
  1.  ;
  1. EN ;----- MAIN ENTRY POINT
  1.  ;
  1.  ;
  1.  S ABMP("INS")=$$INS("ARIZONA MEDICAID")
  1.  I ABMP("INS")'>0  D
  1.  . S ABMP("INS")=0
  1.  . W !?5,"CAN'T FIND 'ARIZONA MEDICAID' IN INSURER FILE"
  1.  . W !?5,"CANNOT CONTINUE!!!"
  1.  Q:'ABMP("INS")
  1.  ;
  1.  Q
  1. INS(X) ;
  1.  ;----- CHECK FOR INSURER IN INSURER FILE
  1.  ;   
  1.  ;      INPUT:
  1.  ;      X  =  INSURANCE COMPANY NAME
  1.  ;      
  1.  ;      OUTPUT:
  1.  ;      Y  =  INSURANCE COMPANY IEN
  1.  ;      
  1.  N DIC,Y
  1.  S DIC="^AUTNINS("
  1.  S DIC(0)="I"
  1.  D ^DIC
  1.  Q +Y
  1.  ;
  1.  ;
  1.  ;----- OLD CODE BELOW THIS LINE -----
  1. START ;  *** THIS IS OLD CODE ***
  1.  ;START HERE
  1.  I '$D(ABMP("INS")) D
  1.  .S ABMP("INS")=$P(^ABMDTXST(DUZ(2),ABMP("XMIT"),0),"^",4)
  1.  .I 'ABMP("INS") D
  1.  ..S DIC="^AUTNINS("
  1.  ..S DIC(0)="AEMQ"
  1.  ..D ^DIC
  1.  ..Q:Y<0
  1.  ..S ABMP("INS")=+Y
  1.  .S ABMP("ITYPE")=$P($G(^AUTNINS(ABMP("INS"),2)),"^",1)
  1.  I 'ABMP("INS") D  Q
  1.  .W !,"Insurer NOT identified.",!
  1.  .S DIR="E"
  1.  .D ^DIR
  1.  .K DIR
  1.  .Q
  1.  S ABMP("FTYPE")=$P($G(^ABMDPARM(DUZ(2),1,3)),"^",4)
  1.  S:ABMP("FTYPE")="" ABMP("FTYPE")="H"
  1.  D OPEN
  1.  I $G(POP) W !,"File could not be created/opened.",! Q
  1.  S DIE="^ABMDTXST(DUZ(2),"
  1.  S DA=ABMP("XMIT")
  1.  S DR=".14///"_ABMFN
  1.  D ^DIE
  1.  ;
  1. LOOP ;
  1.  ; LOOP THROUGH BILLS
  1.  S ABMP("L#")=0
  1.  S ABMEF("BATCH#")=0
  1.  S ABMP("MP")=1
  1.  K ABMR,ABMRT
  1.  D ^ABMER01
  1.  I $$RCID^ABMERUTL(ABMP("INS"))="00400" U 0 W !,"BATCH #",ABMR(1,170),!
  1.  U 0 W !,"Writing bills to file.",!
  1.  S ABMEF("LINE")=ABMREC(1)
  1.  D WRITE
  1.  S ABMP("OLDFN")=0
  1.  S ABMP("OBTYP")=0
  1.  S ABMP("ORD")=0
  1.  F  S ABMP("ORD")=$O(^ABMDTXST(DUZ(2),ABMP("XMIT"),2,ABMP("ORD"))) Q:'ABMP("ORD")  D
  1.  .S ABMP("BDFN")=+^ABMDTXST(DUZ(2),ABMP("XMIT"),2,ABMP("ORD"),0)
  1.  .Q:'$D(^ABMDBILL(DUZ(2),ABMP("BDFN"),0))
  1.  .Q:$P(^ABMDBILL(DUZ(2),ABMP("BDFN"),0),"^",4)="X"
  1.  .S ABMBIL0=$G(^ABMDBILL(DUZ(2),ABMP("BDFN"),0))
  1.  .S ABMP("BTYP")=$P(ABMBIL0,U,2)
  1.  .S ABMP("LDFN")=$P(ABMBIL0,U,3)
  1.  .S ABMP("VTYP")=$P(ABMBIL0,U,7)
  1.  .I ABMP("BTYP")'=ABMP("OBTYP")!(ABMP("LDFN")'=ABMP("OLDFN")) D
  1.  ..;new code patch #1
  1.  ..I $$RCID^ABMERUTL(ABMP("INS"))=61044,$G(ABMEF("BATCH#")) Q
  1.  ..;end new code
  1.  ..S ABMEF("BATCH#")=ABMEF("BATCH#")+1
  1.  ..I ABMP("OBTYP") D
  1.  ...D ^ABMER95
  1.  ...S ABMEF("LINE")=ABMREC(95)
  1.  ...D WRITE
  1.  ..D ^ABMER10
  1.  ..S ABMEF("LINE")=ABMREC(10)
  1.  ..D WRITE
  1.  ..S ABMP("OBTYP")=ABMP("BTYP")
  1.  ..S ABMP("OLDFN")=ABMP("LDFN")
  1.  .W "."
  1.  .K ABMR
  1.  .D ^ABMER20
  1.  .S ABMEF("LINE")=ABMREC(20)
  1.  .D WRITE
  1.  .K ABMR
  1.  .D ^ABMER30
  1.  .F I=1:1:3 D
  1.  ..I $D(ABMREC(30,I)) D
  1.  ...S ABMEF("LINE")=ABMREC(30,I)
  1.  ...D WRITE
  1.  ..I $D(ABMREC(31,I)) D
  1.  ...S ABMEF("LINE")=ABMREC(31,I)
  1.  ...D WRITE
  1.  .K ABMR
  1.  .D ^ABMER40
  1.  .F I=1:1:3 D
  1.  ..I $D(ABMREC(40,I)) D
  1.  ...S ABMEF("LINE")=ABMREC(40,I)
  1.  ...D WRITE
  1.  .I $D(^ABMDBILL(DUZ(2),ABMP("BDFN"),53))!($D(^ABMDBILL(DUZ(2),ABMP("BDFN"),55))) D
  1.  ..D ^ABMER41
  1.  ..F I=1:1:3 D
  1.  ...I $D(ABMREC(41,I)) D
  1.  ....S ABMEF("LINE")=ABMREC(41,I)
  1.  ....D WRITE
  1.  .; If inpatient
  1.  .I $E(ABMP("BTYP"),1,2)=11 D
  1.  ..K ABMR
  1.  ..D ^ABMER50
  1.  ..S I=0
  1.  ..F  S I=$O(ABMREC(50,I)) Q:'I  D
  1.  ...S ABMEF("LINE")=ABMREC(50,I)
  1.  ...D WRITE
  1.  ..Q:+$G(ABMR(50,40))=100
  1.  ..K ABMR
  1.  ..D ^ABMER60
  1.  ..S I=0
  1.  ..F  S I=$O(ABMREC(60,I)) Q:'I  D
  1.  ...S ABMEF("LINE")=ABMREC(60,I)
  1.  ...D WRITE
  1.  .; If outpatient
  1.  .I $E(ABMP("BTYP"),1,2)'=11 D
  1.  ..K ABMR
  1.  ..D ^ABMER61
  1.  ..S I=0
  1.  ..F  S I=$O(ABMREC(61,I)) Q:'I  D
  1.  ...S ABMEF("LINE")=ABMREC(61,I)
  1.  ...D WRITE
  1.  .K ABMR
  1.  .D ^ABMER70
  1.  .S ABMEF("LINE")=ABMREC(70)
  1.  .D WRITE
  1.  .K ABMR
  1.  .D ^ABMER80
  1.  .F I=1:1:3 D
  1.  ..I $D(ABMREC(80,I)) D
  1.  ...S ABMEF("LINE")=ABMREC(80,I)
  1.  ...D WRITE
  1.  .K ABMR
  1.  .D ^ABMER90
  1.  .S ABMEF("LINE")=ABMREC(90)
  1.  .D WRITE
  1.  .S DIE="^ABMDBILL(DUZ(2),"
  1.  .S DA=ABMP("BDFN")
  1.  .S DR=".04////B;.16////A;.17////"_ABMP("XMIT")
  1.  .D ^DIE
  1.  K ABMR
  1.  D ^ABMER95
  1.  S ABMEF("LINE")=ABMREC(95)
  1.  D WRITE
  1.  K ABMR
  1.  D ^ABMER99
  1.  S ABMEF("LINE")=ABMREC(99)
  1.  D WRITE
  1.  D CLOSE
  1.  W !!,"Finished.",!!
  1.  K ABME,ABM,ABMEF,ABMREC,ABMR,ABMRV,ABMFN,ABMLF,ABMLNUM,ABMPATH
  1.  Q
  1.  ;
  1. OPEN ;
  1.  ; OPEN FILE
  1.  I ABMP("FTYPE")="K" D
  1.  .S POP=0
  1.  .S DIC="^DIZ(8980,"
  1.  .S DIC(0)="AEMQL"
  1.  .S DIC("S")="I $P(^(0),""^"",5)=DUZ"
  1.  .D ^DIC
  1.  .K DIC
  1.  .I Y<0 S POP=1 Q
  1.  .S ABMP("FILE#")=+Y
  1.  .S ABMFN=$P(Y,"^",2)
  1.  .I $O(^DIZ(8980,ABMP("FILE#"),2,0)) D
  1.  ..W !,*7,"Data already exists in this file!",!
  1.  ..S DIR("A")="Delete"
  1.  ..S DIR(0)="Y"
  1.  ..S DIR("B")="NO"
  1.  ..D ^DIR
  1.  ..K DIR
  1.  ..I Y=1 K ^DIZ(8980,ABMP("FILE#"),2)
  1.  ..I Y=0 S POP=1
  1.  I ABMP("FTYPE")="H" D
  1.  .S DIR(0)="9002274.5,.47"
  1.  .S DIR("A")="Enter Path"
  1.  .S DIR("B")=$P($G(^ABMDPARM(DUZ(2),1,4)),"^",7)
  1.  .D ^DIR K DIR
  1.  .I Y["^" S POP=1 Q
  1.  .S ABMPATH=Y
  1.  .S ABMRCID=$P(^AUTNINS(ABMP("INS"),0),"^",8)
  1.  .I $L(ABMRCID)<5 D
  1.  ..S ABMRCID=$E("00000",1,5-$L(ABMRCID))_ABMRCID
  1.  .S ABMJDT=$$JDT^XBFUNC(DT)
  1.  .S ABMLF=$G(^ABMNINS("ALF",ABMP("INS")))
  1.  .S:$P(ABMLF,".",2)'=ABMJDT ABMLF=""
  1.  .S ABMLNUM=+$E($P(ABMLF,".",1),7,8)
  1.  .S ABMLNUM=ABMLNUM+1
  1.  .I ABMLNUM<10 S ABMLNUM="0"_ABMLNUM
  1.  .S ABMFN="E"_ABMRCID_ABMLNUM_"."_ABMJDT
  1.  . S DIR(0)="F^1:15"
  1.  . S DIR("A")="Enter File Name: "
  1.  . S DIR("B")=ABMFN
  1.  .D ^DIR K DIR
  1.  .I Y["^" S POP=1 Q
  1.  .S ABMFN=Y
  1.  .D OPEN^%ZISH("EMCFILE",ABMPATH,ABMFN,"W")
  1.  .S:'POP ^ABMNINS("ALF",ABMP("INS"))=ABMFN
  1.  I ABMP("FTYPE")="M" D
  1.  .S ABMP("DOMAIN")=$P($G(^ABMDPARM(DUZ(2),1,3)),"^",9)
  1.  .I 'ABMP("DOMAIN") W !,"MM SEND TO DOMAIN NOT DEFINED.",! S POP=1 Q
  1.  .S ABMP("DOMAIN")=$P(^DIC(4.2,ABMP("DOMAIN"),0),"^",1)
  1.  .S XMSUB="EMC FILE FROM "_$P($G(^AUTTLOC(DUZ(2),0)),"^",2)
  1.  .S XMDUZ=DUZ
  1.  .D XMZ^XMA2
  1.  .I XMZ<1 S POP=1 Q
  1.  .S ABMFN="MAIL MSG# "_XMZ
  1.  .W !!,"MAIL MSG# ",XMZ," CREATED.",!
  1.  Q
  1.  ;
  1. WRITE ;
  1.  ;WRITE RECORD TO FILE
  1.  I ABMP("FTYPE")="K" D
  1.  .S ABMP("L#")=ABMP("L#")+1
  1.  .S ^DIZ(8980,ABMP("FILE#"),2,ABMP("L#"),0)=ABMEF("LINE")
  1.  I ABMP("FTYPE")="H" D
  1.  .U IO
  1.  .W ABMEF("LINE"),$C(13,10)
  1.  .U IO(0)
  1.  I ABMP("FTYPE")="M" D
  1.  .S ABMP("L#")=ABMP("L#")+1
  1.  .S ^XMB(3.9,XMZ,2,ABMP("L#"),0)=ABMEF("LINE")
  1.  Q
  1.  ;
  1. CLOSE ;
  1.  ;CLOSE FILE
  1.  I ABMP("FTYPE")="H" D ^%ZISC
  1.  I ABMP("FTYPE")="K" S ^DIZ(8980,ABMP("FILE#"),2,0)="^^"_I_"^"_I_"^"_DT
  1.  I ABMP("FTYPE")="M" D
  1.  .S ^XMB(3.9,XMZ,2,0)="^3.92A^"_ABMP("L#")_"^"_ABMP("L#")_"^"_DT
  1.  .S XMY(".5@"_ABMP("DOMAIN"))=""
  1.  .D ENT1^XMD
  1.  Q