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

ABMDE8X2.m

Go to the documentation of this file. 
  1. ABMDE8X2 ; IHS/SD/SDR - Page 8 - ERROR CHECKS ; 
  1.  ;;2.6;IHS Third Party Billing System;**13,19**;NOV 12, 2009;Build 300
  1.  ;IHS/SD/SDR - 2.6*19 - HEAT173117 - Split from ABMDE8X due to size.
  1.  ;
  1. B1 ;
  1.  S ABMX("X0")=^ABMDCLM(DUZ(2),ABMP("CDFN"),21,ABMX(1),0)
  1.  I $P($$IHSCPT^ABMCVAPI(+ABMX("X0"),ABMP("VDT")),U,2) S ABME(171)=$S('$D(ABME(171)):+ABMX("X0"),1:ABME(171)_","_+ABMX("X0"))  ;CSV-c
  1.  I ^ABMDEXP(ABMMODE(2),0)["UB" D
  1.  .I $P(ABMX("X0"),U,3)="" S ABME(121)=""
  1.  I $P(ABMX("X0"),U,13)="" S ABME(123)=""
  1.  I (^ABMDEXP(ABMMODE(2),0)["HCFA")!(^ABMDEXP(ABMMODE(2),0)["CMS") D
  1.  .I $P(ABMX("X0"),U,4)="" S ABME(122)=""
  1.  .S ABMCODXS=$P(ABMX("X0"),U,4)
  1.  .I ABMCODXS'="" D
  1.  ..F ABMJ=1:1 S ABMCODX=$P(ABMCODXS,",",ABMJ) Q:+$G(ABMCODX)=0  D
  1.  ...;end old start new  ;abm*2.6*8
  1.  ...;I +$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),17,"C",ABMCODX,0))=0,($G(ABME(217))'="") S ABME(217)=$G(ABME(217))_","_ABMX("I")  ;ABM*2.6*14 HEAT163747
  1.  ...I +$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),17,"C",ABMCODX,0))=0,($G(ABME(217))'="") Q:ABME(217)[(ABMX("I"))  S ABME(217)=$G(ABME(217))_","_ABMX("I")  ;abm*2.6*14 HEAT163747
  1.  ...I +$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),17,"C",ABMCODX,0))=0,($G(ABME(217))="") S ABME(217)=ABMX("I")
  1.  ...;end new
  1.  I $P(ABMX("X0"),U,5)="" S ABME(125)=""
  1.  I $P(ABMX("X0"),U,6)="" S ABME(124)=""
  1.  I $P(ABMX("X0"),U,7)="" S ABME(126)=""
  1.  I $P(ABMX("X0"),U,8)="Y" S ABME(164)=$S('$D(ABME(164)):ABMX("I"),1:ABME(164)_","_ABMX("I"))
  1.  I $P(ABMX("X0"),U,5)]"",$P(ABMX("X0"),U,5)<ABMP("VDT") S ABME(127)=""
  1.  I $G(ABMP("DDT")),$P(ABMX("X0"),U,5)]"",($P(ABMX("X0"),U,5)\1)>ABMP("DDT") S ABME(130)=""
  1.  I $D(^ABMNINS(ABMP("LDFN"),ABMP("INS"),5,"B",+ABMX("X0")))&($P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),21,ABMX,2)),U,2)="") D  ;abm*2.6*9 NARR
  1.  .Q:$P($G(^ABMDEXP(ABMP("EXP"),0)),U)'["5010"  ;abm*2.6*9 NARR
  1.  .K ABMP("CPTNT") S ABMP("CPTNT")=$O(^ABMNINS(ABMP("LDFN"),ABMP("INS"),5,"B",+ABMX("X0"),0))  ;abm*2.6*9 NARR
  1.  .Q:($P($G(^ABMNINS(ABMP("LDFN"),ABMP("INS"),5,ABMP("CPTNT"),0)),U,2)'="Y")  ;abm*2.6*9 NARR
  1.  .S ABME(241)=$S('$D(ABME(241)):ABMX("I"),1:ABME(241)_","_ABMX("I"))  ;abm*2.6*9 NARR
  1.  ;I ABMMODE(2)=22!(ABMMODE(2)=27) D  ;abm*2.6*13 export mode 35
  1.  I ABMMODE(2)=22!(ABMMODE(2)=27)!(ABMMODE(2)=35) D  ;abm*2.6*13 export mode 35
  1.  .S ABMPIEN=0
  1.  .F  S ABMPIEN=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),21,ABMX,"P",ABMPIEN)) Q:+ABMPIEN=0  D
  1.  ..S ABMNPIUS=$$NPIUSAGE^ABMUTLF(ABMP("LDFN"),ABMP("INS"))
  1.  ..S ABMPRV=$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),21,ABMX,"P",ABMPIEN,0)),U)
  1.  ..;start old new abm*2.6*8 NOHEAT
  1.  ..I ABMNPIUS="N",($P($$NPI^XUSNPI("Individual_ID",ABMPRV),U)<0) S ABME(220)=$S('$D(ABME(220)):ABMX("I"),1:ABME(220)_","_ABMX("I"))
  1.  ..I ABMNPIUS="B",($P($$NPI^XUSNPI("Individual_ID",ABMPRV),U)<0) S ABME(221)=$S('$D(ABME(221)):ABMX("I"),1:ABME(221)_","_ABMX("I"))
  1.  ..;end new
  1.  ..Q:$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),21,ABMX,"P",ABMPIEN,0)),U,2)'="D"
  1.  ..S ABMPRV=$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),21,ABMX,"P",ABMPIEN,0)),U)
  1.  ..I $P($G(^VA(200,ABMPRV,.11)),U)="" S ABME(216)=ABMX  ;provider street
  1.  ..I $P($G(^VA(200,ABMPRV,.11)),U,4)="" S ABME(216)=ABMX  ;city
  1.  ..I $P($G(^VA(200,ABMPRV,.11)),U,5)="" S ABME(216)=ABMX  ;state
  1.  ..I $P($G(^VA(200,ABMPRV,.11)),U,6)="" S ABME(216)=ABMX  ;zip
  1.  K ABMPIEN
  1.  Q
  1.  ;
  1. D2 ;EP - this next section compares entries in V Med vs 23 multiple; will
  1.  ;display warning if entry in V Med that's not in 23 multiple
  1.  ;build array of V Med entries by drug with count of occurances
  1.  ;  ABMMEDS(V MED IEN)=  P1=# OF V MED ENTRIES
  1.  ;                       P2=# OF 23 MULTIPLE ENTRIES
  1.  ;                       P3=DATE DISCONTINUED
  1.  ;                       P4=RETURN TO STOCK DATE
  1.  S ABMVIEN=0
  1.  K ABMMEDS
  1.  F  S ABMVIEN=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),11,ABMVIEN)) Q:+ABMVIEN=0  D
  1.  .S ABMVDFN=$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),11,ABMVIEN,0)),U)
  1.  .S ABM=0
  1.  .F  S ABM=$O(^AUPNVMED("AD",ABMVDFN,ABM)) Q:'ABM  D
  1.  ..I $P($G(^AUPNVMED(ABM,0)),U)'="" D
  1.  ...S ABMMEDS($P(^AUPNVMED(ABM,0),U))=+$G(ABMMEDS($P(^AUPNVMED(ABM,0),U)))+1
  1.  ...S $P(ABMMEDS($P(^AUPNVMED(ABM,0),U)),U,3)=$P($G(^AUPNVMED(ABM,0)),U,8)  ;date disc.
  1.  ...S $P(ABMMEDS($P(^AUPNVMED(ABM,0),U)),U,4)=$P($G(^PSDRUG($P($G(^AUPNVMED(ABM,0)),U),2)),U,15)  ;RTS
  1.  ;build array of 23-multiple entries by drug with count of occurances
  1.  S ABMVIEN=0
  1.  F  S ABMVIEN=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),23,ABMVIEN)) Q:+ABMVIEN=0  D
  1.  .S ABMVDATA=$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),23,ABMVIEN,0)),U)
  1.  .S $P(ABMMEDS(ABMVDATA),U,2)=$P(+$G(ABMMEDS(ABMVDATA)),U,2)+1
  1.  ;now compare p1 and p2; p1 must be < or = p2
  1.  S ABMVIEN=0,ABMVFLG=0
  1.  K ABME(213)
  1.  F  S ABMVIEN=$O(ABMMEDS(ABMVIEN)) Q:+ABMVIEN=0  D
  1.  .K ABMVMED,ABM23M
  1.  .S ABMVMED=$P(ABMMEDS(ABMVIEN),U)
  1.  .S ABM23M=$P(ABMMEDS(ABMVIEN),U,2)
  1.  .Q:ABMVMED=ABM23M
  1.  .Q:ABM23M>ABMVMED
  1.  .S ABMVFLG=1
  1.  I $G(ABMVFLG)=1 S ABME(213)=""
  1.  K ABMVFLG,ABMVIEN,ABMVMED,ABM23M
  1.  Q