BNIGT ; cmi/anch/maw - BNI CPHAD GUI Table Utilties 7/24/2007 1:24:55 PM
;;1.0;BNI CPHD ACTIVITY DATASYSTEM;**1**;DEC 20, 2006
;
;
;this routine will contain all table loads for the Visual CPHAD application
;
;cmi/anch/maw 7/24/2007 error when selecting one provider in PRV patch 1
;
;
Q
;
PRV(BNIRET,BNISTR) ;-- get all providers
S X="MERR^BNIGU",@^%ZOSF("TRAP") ; m error trap
N BNIPRV,BNII,BNIERR,BNIIEN,BNIDA,BNIR,P
S P="|"
K ^BNITMP($J)
S BNIRET="^BNITMP("_$J_")"
S BNII=0
S BNIERR=""
I '$G(BNISTR) S BNISTR="" ;cmi/anch/maw 7/24/2007 error when pressing SELECT button patch 1
S BNIR=$P(BNISTR,P)
S ^BNITMP($J,BNII)="T00007BMXIEN^T00050Provider"_$C(30)
S BNIDA=0 F S BNIDA=$O(^VA(200,"B",BNIDA)) Q:BNIDA="" D
. S BNIIEN=0 F S BNIIEN=$O(^VA(200,"B",BNIDA,BNIIEN)) Q:'BNIIEN D
.. I '$G(BNIR) Q:'$O(^VA(200,"AK.PROVIDER",BNIDA,0)) ;not a provider
.. I '$G(BNIR) Q:$P($G(^VA(200,BNIIEN,"PS")),U,4) ;inactive
.. S BNIPRV=$P($G(^VA(200,BNIIEN,0)),U)
.. S BNII=BNII+1
.. S ^BNITMP($J,BNII)=BNIIEN_U_BNIPRV_$C(30)
S ^BNITMP($J,BNII+1)=$C(31)_$G(BNIERR)
Q
;
COM(BNIRET) ;-- get all communities
S X="MERR^BNIGU",@^%ZOSF("TRAP") ; m error trap
N BNICOM,BNICOMS,BNII,BNIERR,BNIIEN,BNIDA
K ^BNITMP($J)
S BNIRET="^BNITMP("_$J_")"
S BNII=0
S BNIERR=""
S ^BNITMP($J,BNII)="T00007BMXIEN^T00050Taxonomy"_$C(30)
S BNIDA=0 F S BNIDA=$O(^AUTTCOM("B",BNIDA)) Q:BNIDA="" D
. S BNIIEN=0 F S BNIIEN=$O(^AUTTCOM("B",BNIDA,BNIIEN)) Q:'BNIIEN D
.. S BNICOM=$P($G(^AUTTCOM(BNIIEN,0)),U)
.. S BNICOMS=$S($P($G(^AUTTCOM(BNIIEN,0)),U,3):$P($G(^DIC(5,$P($G(^AUTTCOM(BNIIEN,0)),U,3),0)),U,2),1:"")
.. S BNII=BNII+1
.. S ^BNITMP($J,BNII)=BNIIEN_U_BNICOM_"-"_BNICOMS_$C(30)
S ^BNITMP($J,BNII+1)=$C(31)_$G(BNIERR)
Q
;
TAX(BNIRET,BNISTR) ;-- generic taxonomy table
S X="MERR^BNIGU",@^%ZOSF("TRAP") ; m error trap
N P,BNIRFL,BNII,BNIERR,BNIIEN,BNITAXE,BNITAX,BNIDA,BNINONC,BNIXRF
N BNIGL,BNIGRF,BNIP
S P="|"
K ^BNITMP($J)
S BNIRET="^BNITMP("_$J_")"
S BNII=0
S BNIERR=""
S ^BNITMP($J,BNII)="T00080BMXIEN^T00080Taxonomy"_$C(30)
F BNIP=3:1 S BNITAXE=$P(BNISTR,P,BNIP) Q:$G(BNITAXE)="" D
. Q:$G(BNITAXE)=""
. ;S BNITAXE=$P(BNISTR,P)
. S BNITAX=$O(^ATXAX("B",BNITAXE,0))
. Q:'$G(BNITAX)
. S BNINONC=$P($G(^ATXAX(BNITAX,0)),U,13)
. S BNIXRF=$P($G(^ATXAX(BNITAX,0)),U,14)
. S BNIFL=$P($G(^ATXAX(BNITAX,0)),U,15)
. ;I $G(BNIXRF)="" S BNIXRF="B"
. I BNIFL=80 S BNIXRF="BA" ;icd diagnosis x ref
. I BNIFL=80.1 S BNIXRF="BA" ;icd op and proc xref
. ;I $G(BNIXRF)="" S BNIXRF="B"
. S BNIGL=$G(^DIC(BNIFL,0,"GL"))
. S BNIDA=0 F S BNIDA=$O(^ATXAX(BNITAX,21,BNIDA)) Q:'BNIDA D
.. N BNIL,BNIH
.. S BNII=BNII+1
.. S BNIL=$P($G(^ATXAX(BNITAX,21,BNIDA,0)),U)
.. S BNIH=$P($G(^ATXAX(BNITAX,21,BNIDA,0)),U,2)
.. I (BNIL=BNIH)!($G(BNIH)="") D Q
... I $G(BNIXRF)="" D Q
.... S BNIGRF=BNIGL_""""_BNIL_""""_")"
.... S ^BNITMP($J,BNII)=$P($G(@BNIGRF@(0)),U)_$C(30)
... S ^BNITMP($J,BNII)=BNIL_U_$$GET1^DIQ(BNIFL,BNIL,.01)_$C(30)
.. S BNIGRF=BNIGL_""""_BNIXRF_""")"
.. N BNIIEN
.. S BNIIEN=$O(@BNIGRF@(BNIL),-1)
.. F S BNIIEN=$O(@BNIGRF@(BNIIEN)) Q:BNIIEN>BNIH D
... S BNII=BNII+1
... S ^BNITMP($J,BNII)=BNIIEN_U_$$GET1^DIQ(BNIFL,BNIIEN,.01)_$C(30)
S ^BNITMP($J,BNII+1)=$C(31)_$G(BNIERR)
Q
;
GRET(BNIRET,BNISTR) ;-- get general retrieval items based on value passed in
N P,BNII
S P="|"
K ^BNITMP($J)
S BNIRET="^BNITMP("_$J_")"
S BNII=0
S ^BNITMP($J,BNII)="T00007BMXIEN^T00200ITEMS^T00001TYPE^T00050CALL^T00010CW"_$C(30)
N BNIIEN
S BNIIEN=0 F S BNIIEN=$O(^BNIGRI("C",BNIIEN)) Q:'BNIIEN D
. N BNIDA
. S BNIDA=0 F S BNIDA=$O(^BNIGRI("C",BNIIEN,BNIDA)) Q:'BNIDA D
.. N BNIDATA,BNITYP,BNIFL,BNICW
.. S BNIDATA=$G(^BNIGRI(BNIDA,0))
.. S BNITYP=$P(BNIDATA,U,2)
.. S BNIFL=$P(BNIDATA,U,14)
.. S BNICW=$P(BNIDATA,U,7)
.. Q:$P(^BNIGRI(BNIDA,0),U,5)'[BNISTR
.. S BNII=BNII+1
.. S ^BNITMP($J,BNII)=BNIDA_U_$P(BNIDATA,U)_U_BNITYP_U_BNIFL_U_BNICW_$C(30)
S ^BNITMP($J,BNII+1)=$C(31)
Q
;
REP(BNIRET) ;-- get gen retrieval reports
K ^BNITMP($J)
S BNIRET="^BNITMP("_$J_")"
N BNII
S BNII=0
S ^BNITMP($J,BNII)="T00080REPORT"_$C(30)
N BNIDA
S BNIDA=0 F S BNIDA=$O(^BNIRTMP("C",BNIDA)) Q:BNIDA="" D
. N BNIIEN
. S BNIIEN=0 F S BNIIEN=$O(^BNIRTMP("C",BNIDA,BNIIEN)) Q:'BNIIEN D
.. Q:$P($G(^BNIRTMP(BNIIEN,0)),U,13)'=DUZ
.. S BNII=BNII+1
.. S ^BNITMP($J,BNII)=$P($G(^BNIRTMP(BNIIEN,0)),U,3)_$C(30)
S ^BNITMP($J,BNII+1)=$C(31)
Q
;
BNIGT ; cmi/anch/maw - BNI CPHAD GUI Table Utilties 7/24/2007 1:24:55 PM
+1 ;;1.0;BNI CPHD ACTIVITY DATASYSTEM;**1**;DEC 20, 2006
+2 ;
+3 ;
+4 ;this routine will contain all table loads for the Visual CPHAD application
+5 ;
+6 ;cmi/anch/maw 7/24/2007 error when selecting one provider in PRV patch 1
+7 ;
+8 ;
+9 QUIT
+10 ;
PRV(BNIRET,BNISTR) ;-- get all providers
+1 ; m error trap
SET X="MERR^BNIGU"
SET @^%ZOSF("TRAP")
+2 NEW BNIPRV,BNII,BNIERR,BNIIEN,BNIDA,BNIR,P
+3 SET P="|"
+4 KILL ^BNITMP($JOB)
+5 SET BNIRET="^BNITMP("_$JOB_")"
+6 SET BNII=0
+7 SET BNIERR=""
+8 ;cmi/anch/maw 7/24/2007 error when pressing SELECT button patch 1
IF '$GET(BNISTR)
SET BNISTR=""
+9 SET BNIR=$PIECE(BNISTR,P)
+10 SET ^BNITMP($JOB,BNII)="T00007BMXIEN^T00050Provider"_$CHAR(30)
+11 SET BNIDA=0
FOR
SET BNIDA=$ORDER(^VA(200,"B",BNIDA))
IF BNIDA=""
QUIT
Begin DoDot:1
+12 SET BNIIEN=0
FOR
SET BNIIEN=$ORDER(^VA(200,"B",BNIDA,BNIIEN))
IF 'BNIIEN
QUIT
Begin DoDot:2
+13 ;not a provider
IF '$GET(BNIR)
IF '$ORDER(^VA(200,"AK.PROVIDER",BNIDA,0))
QUIT
+14 ;inactive
IF '$GET(BNIR)
IF $PIECE($GET(^VA(200,BNIIEN,"PS")),U,4)
QUIT
+15 SET BNIPRV=$PIECE($GET(^VA(200,BNIIEN,0)),U)
+16 SET BNII=BNII+1
+17 SET ^BNITMP($JOB,BNII)=BNIIEN_U_BNIPRV_$CHAR(30)
End DoDot:2
End DoDot:1
+18 SET ^BNITMP($JOB,BNII+1)=$CHAR(31)_$GET(BNIERR)
+19 QUIT
+20 ;
COM(BNIRET) ;-- get all communities
+1 ; m error trap
SET X="MERR^BNIGU"
SET @^%ZOSF("TRAP")
+2 NEW BNICOM,BNICOMS,BNII,BNIERR,BNIIEN,BNIDA
+3 KILL ^BNITMP($JOB)
+4 SET BNIRET="^BNITMP("_$JOB_")"
+5 SET BNII=0
+6 SET BNIERR=""
+7 SET ^BNITMP($JOB,BNII)="T00007BMXIEN^T00050Taxonomy"_$CHAR(30)
+8 SET BNIDA=0
FOR
SET BNIDA=$ORDER(^AUTTCOM("B",BNIDA))
IF BNIDA=""
QUIT
Begin DoDot:1
+9 SET BNIIEN=0
FOR
SET BNIIEN=$ORDER(^AUTTCOM("B",BNIDA,BNIIEN))
IF 'BNIIEN
QUIT
Begin DoDot:2
+10 SET BNICOM=$PIECE($GET(^AUTTCOM(BNIIEN,0)),U)
+11 SET BNICOMS=$SELECT($PIECE($GET(^AUTTCOM(BNIIEN,0)),U,3):$PIECE($GET(^DIC(5,$PIECE($GET(^AUTTCOM(BNIIEN,0)),U,3),0)),U,2),1:"")
+12 SET BNII=BNII+1
+13 SET ^BNITMP($JOB,BNII)=BNIIEN_U_BNICOM_"-"_BNICOMS_$CHAR(30)
End DoDot:2
End DoDot:1
+14 SET ^BNITMP($JOB,BNII+1)=$CHAR(31)_$GET(BNIERR)
+15 QUIT
+16 ;
TAX(BNIRET,BNISTR) ;-- generic taxonomy table
+1 ; m error trap
SET X="MERR^BNIGU"
SET @^%ZOSF("TRAP")
+2 NEW P,BNIRFL,BNII,BNIERR,BNIIEN,BNITAXE,BNITAX,BNIDA,BNINONC,BNIXRF
+3 NEW BNIGL,BNIGRF,BNIP
+4 SET P="|"
+5 KILL ^BNITMP($JOB)
+6 SET BNIRET="^BNITMP("_$JOB_")"
+7 SET BNII=0
+8 SET BNIERR=""
+9 SET ^BNITMP($JOB,BNII)="T00080BMXIEN^T00080Taxonomy"_$CHAR(30)
+10 FOR BNIP=3:1
SET BNITAXE=$PIECE(BNISTR,P,BNIP)
IF $GET(BNITAXE)=""
QUIT
Begin DoDot:1
+11 IF $GET(BNITAXE)=""
QUIT
+12 ;S BNITAXE=$P(BNISTR,P)
+13 SET BNITAX=$ORDER(^ATXAX("B",BNITAXE,0))
+14 IF '$GET(BNITAX)
QUIT
+15 SET BNINONC=$PIECE($GET(^ATXAX(BNITAX,0)),U,13)
+16 SET BNIXRF=$PIECE($GET(^ATXAX(BNITAX,0)),U,14)
+17 SET BNIFL=$PIECE($GET(^ATXAX(BNITAX,0)),U,15)
+18 ;I $G(BNIXRF)="" S BNIXRF="B"
+19 ;icd diagnosis x ref
IF BNIFL=80
SET BNIXRF="BA"
+20 ;icd op and proc xref
IF BNIFL=80.1
SET BNIXRF="BA"
+21 ;I $G(BNIXRF)="" S BNIXRF="B"
+22 SET BNIGL=$GET(^DIC(BNIFL,0,"GL"))
+23 SET BNIDA=0
FOR
SET BNIDA=$ORDER(^ATXAX(BNITAX,21,BNIDA))
IF 'BNIDA
QUIT
Begin DoDot:2
+24 NEW BNIL,BNIH
+25 SET BNII=BNII+1
+26 SET BNIL=$PIECE($GET(^ATXAX(BNITAX,21,BNIDA,0)),U)
+27 SET BNIH=$PIECE($GET(^ATXAX(BNITAX,21,BNIDA,0)),U,2)
+28 IF (BNIL=BNIH)!($GET(BNIH)="")
Begin DoDot:3
+29 IF $GET(BNIXRF)=""
Begin DoDot:4
+30 SET BNIGRF=BNIGL_""""_BNIL_""""_")"
+31 SET ^BNITMP($JOB,BNII)=$PIECE($GET(@BNIGRF@(0)),U)_$CHAR(30)
End DoDot:4
QUIT
+32 SET ^BNITMP($JOB,BNII)=BNIL_U_$$GET1^DIQ(BNIFL,BNIL,.01)_$CHAR(30)
End DoDot:3
QUIT
+33 SET BNIGRF=BNIGL_""""_BNIXRF_""")"
+34 NEW BNIIEN
+35 SET BNIIEN=$ORDER(@BNIGRF@(BNIL),-1)
+36 FOR
SET BNIIEN=$ORDER(@BNIGRF@(BNIIEN))
IF BNIIEN>BNIH
QUIT
Begin DoDot:3
+37 SET BNII=BNII+1
+38 SET ^BNITMP($JOB,BNII)=BNIIEN_U_$$GET1^DIQ(BNIFL,BNIIEN,.01)_$CHAR(30)
End DoDot:3
End DoDot:2
End DoDot:1
+39 SET ^BNITMP($JOB,BNII+1)=$CHAR(31)_$GET(BNIERR)
+40 QUIT
+41 ;
GRET(BNIRET,BNISTR) ;-- get general retrieval items based on value passed in
+1 NEW P,BNII
+2 SET P="|"
+3 KILL ^BNITMP($JOB)
+4 SET BNIRET="^BNITMP("_$JOB_")"
+5 SET BNII=0
+6 SET ^BNITMP($JOB,BNII)="T00007BMXIEN^T00200ITEMS^T00001TYPE^T00050CALL^T00010CW"_$CHAR(30)
+7 NEW BNIIEN
+8 SET BNIIEN=0
FOR
SET BNIIEN=$ORDER(^BNIGRI("C",BNIIEN))
IF 'BNIIEN
QUIT
Begin DoDot:1
+9 NEW BNIDA
+10 SET BNIDA=0
FOR
SET BNIDA=$ORDER(^BNIGRI("C",BNIIEN,BNIDA))
IF 'BNIDA
QUIT
Begin DoDot:2
+11 NEW BNIDATA,BNITYP,BNIFL,BNICW
+12 SET BNIDATA=$GET(^BNIGRI(BNIDA,0))
+13 SET BNITYP=$PIECE(BNIDATA,U,2)
+14 SET BNIFL=$PIECE(BNIDATA,U,14)
+15 SET BNICW=$PIECE(BNIDATA,U,7)
+16 IF $PIECE(^BNIGRI(BNIDA,0),U,5)'[BNISTR
QUIT
+17 SET BNII=BNII+1
+18 SET ^BNITMP($JOB,BNII)=BNIDA_U_$PIECE(BNIDATA,U)_U_BNITYP_U_BNIFL_U_BNICW_$CHAR(30)
End DoDot:2
End DoDot:1
+19 SET ^BNITMP($JOB,BNII+1)=$CHAR(31)
+20 QUIT
+21 ;
REP(BNIRET) ;-- get gen retrieval reports
+1 KILL ^BNITMP($JOB)
+2 SET BNIRET="^BNITMP("_$JOB_")"
+3 NEW BNII
+4 SET BNII=0
+5 SET ^BNITMP($JOB,BNII)="T00080REPORT"_$CHAR(30)
+6 NEW BNIDA
+7 SET BNIDA=0
FOR
SET BNIDA=$ORDER(^BNIRTMP("C",BNIDA))
IF BNIDA=""
QUIT
Begin DoDot:1
+8 NEW BNIIEN
+9 SET BNIIEN=0
FOR
SET BNIIEN=$ORDER(^BNIRTMP("C",BNIDA,BNIIEN))
IF 'BNIIEN
QUIT
Begin DoDot:2
+10 IF $PIECE($GET(^BNIRTMP(BNIIEN,0)),U,13)'=DUZ
QUIT
+11 SET BNII=BNII+1
+12 SET ^BNITMP($JOB,BNII)=$PIECE($GET(^BNIRTMP(BNIIEN,0)),U,3)_$CHAR(30)
End DoDot:2
End DoDot:1
+13 SET ^BNITMP($JOB,BNII+1)=$CHAR(31)
+14 QUIT
+15 ;
