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