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