- 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 ;
