BMXADE2 ; IHS/OIT/HMW - BMXNet ADO.NET PROVIDER ;
;;4.0;BMX;;JUN 28, 2010
;
;
;Dental Excel report demo
;
BMXADE(BMXGBL,BMXBEG,BMXEND) ;EP
;Returns recordset containing services and minutes by reporting facility, Provider, and ADA Code
;
N BMXBEGDT,BMXENDDT,BMXTMP,BMXDT,BMXRD,BMXIEN,BMXNOD,BMXCOM,BMXFAC,BMXSU,BMXCOMP,BMXSUP,BMXFACP,BMXSVC,BMXMIN,BMXLVL,BMXFEE
S U="^",BMXRD=$C(30)
K ^BMXTEMP($J),^BMXTMP($J)
S BMXGBL="^BMXTEMP("_$J_")"
S ^BMXTEMP($J,0)="T00030FACILITY^T00030PROVIDER^T00030ADA_CODE^T00030LEVEL^I00030SERVICES^I00030MINUTES^I00030FEE"_BMXRD
S X=BMXBEG,%DT="P" D ^%DT S BMXBEGDT=Y
S X=BMXEND,%DT="P" D ^%DT S BMXENDDT=Y
I BMXENDDT<BMXBEGDT S BMXTMP=BMXENDDT,BMXENDDT=BMXBEGDT,BMXBEGDT=BMXTMP
S BMXBEGDT=$P(BMXBEGDT,".")
S BMXENDDT=$P(BMXENDDT,"."),$P(BMXENDDT,".",2)=99999
;
;$O Thru ADEPCD("AC" DATE X-REF
;Temp global is (FAC,PROV,CODE)=SVCS^MINS
;
S BMXDT=BMXBEGDT F S BMXDT=$O(^ADEPCD("AC",BMXDT)) Q:'+BMXDT Q:BMXDT>BMXENDDT D
. S BMXIEN=0 F S BMXIEN=$O(^ADEPCD("AC",BMXDT,BMXIEN)) Q:'+BMXIEN D
. . Q:'$D(^ADEPCD(BMXIEN,0))
. . S BMXNOD=^ADEPCD(BMXIEN,0)
. . S BMXFACP=+$P(BMXNOD,U,3)
. . S BMXPRVP=+$P(BMXNOD,U,4)
. . S BMXCODP=0 F S BMXCODP=$O(^ADEPCD(BMXIEN,"ADA","B",BMXCODP)) Q:'+BMXCODP D
. . . D CALCMIN(BMXCODP,.BMXMIN)
. . . D CALCFEE(BMXCODP,.BMXFEE)
. . . S BMXCODPS=0,BMXSVC=0 F S BMXCODPS=$O(^ADEPCD(BMXIEN,"ADA","B",BMXCODP,BMXCODPS)) Q:'+BMXCODPS D
. . . . S BMXSVC=BMXSVC+1
. . . S:'$D(^BMXTMP($J,BMXFACP,BMXPRVP,BMXCODP)) ^BMXTMP($J,BMXFACP,BMXPRVP,BMXCODP)="0^0"
. . . S $P(^BMXTMP($J,BMXFACP,BMXPRVP,BMXCODP),U)=$P(^(BMXCODP),U)+BMXSVC
. . . S $P(^BMXTMP($J,BMXFACP,BMXPRVP,BMXCODP),U,2)=$P(^(BMXCODP),U,2)+(BMXSVC*BMXMIN)
. . . S $P(^BMXTMP($J,BMXFACP,BMXPRVP,BMXCODP),U,3)=$P(^(BMXCODP),U,3)+(BMXSVC*BMXFEE)
. . . Q
. . Q
. Q
;
;Traverse ^BMXTMP and fill in ^BMXTEMP
S BMXI=0
S BMXFACP=-1 F S BMXFACP=$O(^BMXTMP($J,BMXFACP)) Q:BMXFACP="" D
. I BMXFACP=0 S BMXFAC="UNKNOWN"
. E S BMXFAC=$P($G(^DIC(4,BMXFACP,0)),U) S:BMXFAC="" BMXFAC="UNKNOWN"
. S BMXPRVP=-1 F S BMXPRVP=$O(^BMXTMP($J,BMXFACP,BMXPRVP)) Q:BMXPRVP="" D
. . S BMXPRV=$P($G(^DIC(16,BMXPRVP,0)),U) S:BMXPRV="" BMXPRV="UNKNOWN"
. . S BMXCODP=-1 F S BMXCODP=$O(^BMXTMP($J,BMXFACP,BMXPRVP,BMXCODP)) Q:'+BMXCODP D
. . . D CODLVL(BMXCODP,.BMXCOD,.BMXLVL)
. . . S BMXI=BMXI+1
. . . S BMXSVC=$P(^BMXTMP($J,BMXFACP,BMXPRVP,BMXCODP),U)
. . . S BMXMIN=$P(^BMXTMP($J,BMXFACP,BMXPRVP,BMXCODP),U,2)
. . . S BMXFEE=$P(^BMXTMP($J,BMXFACP,BMXPRVP,BMXCODP),U,3)
. . . S ^BMXTEMP($J,BMXI)=BMXFAC_U_BMXPRV_U_BMXCOD_U_BMXLVL_U_BMXSVC_U_BMXMIN_U_BMXFEE_BMXRD
. . . Q
. . Q
. Q
S BMXI=BMXI+1
S ^BMXTEMP($J,BMXI)=$C(31)
Q
;
CALCMIN(BMXCODP,BMXMIN) ;
;Returns Minutes for code BMXCOD
N BMXANOD
S BMXMIN=0
Q:'$D(^AUTTADA(BMXCODP,0))
S BMXANOD=^AUTTADA(BMXCODP,0)
;S BMXLVL=$P(BMXANOD,U,5)
S BMXMIN=$P(BMXANOD,U,4)
Q
;
CALCFEE(BMXCODP,BMXFEE) ;
;Returns FEE for code BMXCOD. Only works for ANMC local fee field
N BMXANOD
S BMXFEE=0
Q:'$D(^AUTTADA(BMXCODP,0))
S BMXANOD=^AUTTADA(BMXCODP,0)
S BMXFEE=+$P(BMXANOD,U,12)
Q
;
CODLVL(BMXCODP,BMXCOD,BMXLVL) ;
;Returns Name and Level of code at ADACODP
N BMXANOD
S BMXCOD="",BMXLVL=""
Q:'$D(^AUTTADA(BMXCODP,0))
S BMXANOD=^AUTTADA(BMXCODP,0)
S BMXCOD=$P(BMXANOD,U)
S BMXLVL=$P(BMXANOD,U,5)
BMXADE2 ; IHS/OIT/HMW - BMXNet ADO.NET PROVIDER ;
+1 ;;4.0;BMX;;JUN 28, 2010
+2 ;
+3 ;
+4 ;Dental Excel report demo
+5 ;
BMXADE(BMXGBL,BMXBEG,BMXEND) ;EP
+1 ;Returns recordset containing services and minutes by reporting facility, Provider, and ADA Code
+2 ;
+3 NEW BMXBEGDT,BMXENDDT,BMXTMP,BMXDT,BMXRD,BMXIEN,BMXNOD,BMXCOM,BMXFAC,BMXSU,BMXCOMP,BMXSUP,BMXFACP,BMXSVC,BMXMIN,BMXLVL,BMXFEE
+4 SET U="^"
SET BMXRD=$CHAR(30)
+5 KILL ^BMXTEMP($JOB),^BMXTMP($JOB)
+6 SET BMXGBL="^BMXTEMP("_$JOB_")"
+7 SET ^BMXTEMP($JOB,0)="T00030FACILITY^T00030PROVIDER^T00030ADA_CODE^T00030LEVEL^I00030SERVICES^I00030MINUTES^I00030FEE"_BMXRD
+8 SET X=BMXBEG
SET %DT="P"
DO ^%DT
SET BMXBEGDT=Y
+9 SET X=BMXEND
SET %DT="P"
DO ^%DT
SET BMXENDDT=Y
+10 IF BMXENDDT<BMXBEGDT
SET BMXTMP=BMXENDDT
SET BMXENDDT=BMXBEGDT
SET BMXBEGDT=BMXTMP
+11 SET BMXBEGDT=$PIECE(BMXBEGDT,".")
+12 SET BMXENDDT=$PIECE(BMXENDDT,".")
SET $PIECE(BMXENDDT,".",2)=99999
+13 ;
+14 ;$O Thru ADEPCD("AC" DATE X-REF
+15 ;Temp global is (FAC,PROV,CODE)=SVCS^MINS
+16 ;
+17 SET BMXDT=BMXBEGDT
FOR
SET BMXDT=$ORDER(^ADEPCD("AC",BMXDT))
IF '+BMXDT
QUIT
IF BMXDT>BMXENDDT
QUIT
Begin DoDot:1
+18 SET BMXIEN=0
FOR
SET BMXIEN=$ORDER(^ADEPCD("AC",BMXDT,BMXIEN))
IF '+BMXIEN
QUIT
Begin DoDot:2
+19 IF '$DATA(^ADEPCD(BMXIEN,0))
QUIT
+20 SET BMXNOD=^ADEPCD(BMXIEN,0)
+21 SET BMXFACP=+$PIECE(BMXNOD,U,3)
+22 SET BMXPRVP=+$PIECE(BMXNOD,U,4)
+23 SET BMXCODP=0
FOR
SET BMXCODP=$ORDER(^ADEPCD(BMXIEN,"ADA","B",BMXCODP))
IF '+BMXCODP
QUIT
Begin DoDot:3
+24 DO CALCMIN(BMXCODP,.BMXMIN)
+25 DO CALCFEE(BMXCODP,.BMXFEE)
+26 SET BMXCODPS=0
SET BMXSVC=0
FOR
SET BMXCODPS=$ORDER(^ADEPCD(BMXIEN,"ADA","B",BMXCODP,BMXCODPS))
IF '+BMXCODPS
QUIT
Begin DoDot:4
+27 SET BMXSVC=BMXSVC+1
End DoDot:4
+28 IF '$DATA(^BMXTMP($JOB,BMXFACP,BMXPRVP,BMXCODP))
SET ^BMXTMP($JOB,BMXFACP,BMXPRVP,BMXCODP)="0^0"
+29 SET $PIECE(^BMXTMP($JOB,BMXFACP,BMXPRVP,BMXCODP),U)=$PIECE(^(BMXCODP),U)+BMXSVC
+30 SET $PIECE(^BMXTMP($JOB,BMXFACP,BMXPRVP,BMXCODP),U,2)=$PIECE(^(BMXCODP),U,2)+(BMXSVC*BMXMIN)
+31 SET $PIECE(^BMXTMP($JOB,BMXFACP,BMXPRVP,BMXCODP),U,3)=$PIECE(^(BMXCODP),U,3)+(BMXSVC*BMXFEE)
+32 QUIT
End DoDot:3
+33 QUIT
End DoDot:2
+34 QUIT
End DoDot:1
+35 ;
+36 ;Traverse ^BMXTMP and fill in ^BMXTEMP
+37 SET BMXI=0
+38 SET BMXFACP=-1
FOR
SET BMXFACP=$ORDER(^BMXTMP($JOB,BMXFACP))
IF BMXFACP=""
QUIT
Begin DoDot:1
+39 IF BMXFACP=0
SET BMXFAC="UNKNOWN"
+40 IF '$TEST
SET BMXFAC=$PIECE($GET(^DIC(4,BMXFACP,0)),U)
IF BMXFAC=""
SET BMXFAC="UNKNOWN"
+41 SET BMXPRVP=-1
FOR
SET BMXPRVP=$ORDER(^BMXTMP($JOB,BMXFACP,BMXPRVP))
IF BMXPRVP=""
QUIT
Begin DoDot:2
+42 SET BMXPRV=$PIECE($GET(^DIC(16,BMXPRVP,0)),U)
IF BMXPRV=""
SET BMXPRV="UNKNOWN"
+43 SET BMXCODP=-1
FOR
SET BMXCODP=$ORDER(^BMXTMP($JOB,BMXFACP,BMXPRVP,BMXCODP))
IF '+BMXCODP
QUIT
Begin DoDot:3
+44 DO CODLVL(BMXCODP,.BMXCOD,.BMXLVL)
+45 SET BMXI=BMXI+1
+46 SET BMXSVC=$PIECE(^BMXTMP($JOB,BMXFACP,BMXPRVP,BMXCODP),U)
+47 SET BMXMIN=$PIECE(^BMXTMP($JOB,BMXFACP,BMXPRVP,BMXCODP),U,2)
+48 SET BMXFEE=$PIECE(^BMXTMP($JOB,BMXFACP,BMXPRVP,BMXCODP),U,3)
+49 SET ^BMXTEMP($JOB,BMXI)=BMXFAC_U_BMXPRV_U_BMXCOD_U_BMXLVL_U_BMXSVC_U_BMXMIN_U_BMXFEE_BMXRD
+50 QUIT
End DoDot:3
+51 QUIT
End DoDot:2
+52 QUIT
End DoDot:1
+53 SET BMXI=BMXI+1
+54 SET ^BMXTEMP($JOB,BMXI)=$CHAR(31)
+55 QUIT
+56 ;
CALCMIN(BMXCODP,BMXMIN) ;
+1 ;Returns Minutes for code BMXCOD
+2 NEW BMXANOD
+3 SET BMXMIN=0
+4 IF '$DATA(^AUTTADA(BMXCODP,0))
QUIT
+5 SET BMXANOD=^AUTTADA(BMXCODP,0)
+6 ;S BMXLVL=$P(BMXANOD,U,5)
+7 SET BMXMIN=$PIECE(BMXANOD,U,4)
+8 QUIT
+9 ;
CALCFEE(BMXCODP,BMXFEE) ;
+1 ;Returns FEE for code BMXCOD. Only works for ANMC local fee field
+2 NEW BMXANOD
+3 SET BMXFEE=0
+4 IF '$DATA(^AUTTADA(BMXCODP,0))
QUIT
+5 SET BMXANOD=^AUTTADA(BMXCODP,0)
+6 SET BMXFEE=+$PIECE(BMXANOD,U,12)
+7 QUIT
+8 ;
CODLVL(BMXCODP,BMXCOD,BMXLVL) ;
+1 ;Returns Name and Level of code at ADACODP
+2 NEW BMXANOD
+3 SET BMXCOD=""
SET BMXLVL=""
+4 IF '$DATA(^AUTTADA(BMXCODP,0))
QUIT
+5 SET BMXANOD=^AUTTADA(BMXCODP,0)
+6 SET BMXCOD=$PIECE(BMXANOD,U)
+7 SET BMXLVL=$PIECE(BMXANOD,U,5)
