BMXADE1 ; 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, patient's community and service unit
;
N BMXBEGDT,BMXENDDT,BMXTMP,BMXDT,BMXRD,BMXIEN,BMXNOD,BMXPAT,BMXCOM,BMXFAC,BMXSU,BMXCOMP,BMXSUP,BMXFACP,BMXSVC,BMXMIN,BMXFEE
S U="^",BMXRD=$C(30)
K ^BMXTEMP($J),^BMXTMP($J)
S BMXGBL="^BMXTEMP("_$J_")"
S ^BMXTEMP($J,0)="T00030FACILITY^T00030PT_COMMUNITY^T00030PT_SERVICE_UNIT^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,COMM)=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 BMXPAT=$P(BMXNOD,U)
. . S BMXFACP=+$P(BMXNOD,U,3)
. . S BMXCOMP=$$GETCOMP(BMXPAT)
. . D CALCMIN(BMXIEN,.BMXSVC,.BMXMIN,.BMXFEE)
. . Q:BMXSVC=0
. . S:'$D(^BMXTMP($J,BMXFACP,BMXCOMP)) ^BMXTMP($J,BMXFACP,BMXCOMP)="0^0^0"
. . S $P(^BMXTMP($J,BMXFACP,BMXCOMP),U)=$P(^(BMXCOMP),U)+BMXSVC
. . S $P(^BMXTMP($J,BMXFACP,BMXCOMP),U,2)=$P(^(BMXCOMP),U,2)+BMXMIN
. . S $P(^BMXTMP($J,BMXFACP,BMXCOMP),U,3)=$P(^(BMXCOMP),U,3)+BMXFEE
. . 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 BMXCOMP=-1 F S BMXCOMP=$O(^BMXTMP($J,BMXFACP,BMXCOMP)) Q:BMXCOMP="" D
. . I BMXCOMP=0 S BMXCOM="UNKNOWN"
. . E S BMXCOM=$P($G(^AUTTCOM(BMXCOMP,0)),U) S:BMXCOM="" BMXCOM="UNKNOWN"
. . S BMXSU=+$P($G(^AUTTCOM(BMXCOMP,0)),U,5)
. . I BMXSU=0 S BMXSU="UNKNOWN"
. . E S BMXSU=$P($G(^AUTTSU(BMXSU,0)),U)
. . S BMXI=BMXI+1
. . S BMXSVC=$P(^BMXTMP($J,BMXFACP,BMXCOMP),U)
. . S BMXMIN=$P(^BMXTMP($J,BMXFACP,BMXCOMP),U,2)
. . S BMXFEE=$P(^BMXTMP($J,BMXFACP,BMXCOMP),U,3)
. . S ^BMXTEMP($J,BMXI)=BMXFAC_U_BMXCOM_U_BMXSU_U_BMXSVC_U_BMXMIN_U_BMXFEE_BMXRD
. . Q
. Q
S BMXI=BMXI+1
S ^BMXTEMP($J,BMXI)=$C(31)
Q
;
GETCOMP(BMXPAT) ;
;Returns Patient Community Pointer
I '$D(^AUPNPAT(BMXPAT,11)) Q 0
Q +$P(^AUPNPAT(BMXPAT,11),U,17)
;
CALCMIN(BMXIEN,BMXSVC,BMXMIN,BMXFEE) ;
;Returns count of lvl 1 - 6 services and minutes for entry BMXIEN
;Uses ANMC rogue FEE field in AUTTADA to calculate FEE data
N BMXA,BMXCOD,BMXALVL
S BMXSVC=0,BMXMIN=0,BMXFEE=0
Q:'$D(^ADEPCD(BMXIEN,"ADA"))
S BMXA=0 F S BMXA=$O(^ADEPCD(BMXIEN,"ADA",BMXA)) Q:'+BMXA D
. S BMXCOD=+^ADEPCD(BMXIEN,"ADA",BMXA,0)
. Q:'$D(^AUTTADA(BMXCOD,0))
. S BMXANOD=^AUTTADA(BMXCOD,0)
. S BMXALVL=$P(BMXANOD,U,5)
. Q:BMXALVL=0
. Q:BMXALVL>6
. S BMXSVC=BMXSVC+1
. S BMXMIN=BMXMIN+$P(BMXANOD,U,4)
. S BMXFEE=BMXFEE+$P(BMXANOD,U,12)
Q
BMXADE1 ; 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, patient's community and service unit
+2 ;
+3 NEW BMXBEGDT,BMXENDDT,BMXTMP,BMXDT,BMXRD,BMXIEN,BMXNOD,BMXPAT,BMXCOM,BMXFAC,BMXSU,BMXCOMP,BMXSUP,BMXFACP,BMXSVC,BMXMIN,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^T00030PT_COMMUNITY^T00030PT_SERVICE_UNIT^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,COMM)=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 BMXPAT=$PIECE(BMXNOD,U)
+22 SET BMXFACP=+$PIECE(BMXNOD,U,3)
+23 SET BMXCOMP=$$GETCOMP(BMXPAT)
+24 DO CALCMIN(BMXIEN,.BMXSVC,.BMXMIN,.BMXFEE)
+25 IF BMXSVC=0
QUIT
+26 IF '$DATA(^BMXTMP($JOB,BMXFACP,BMXCOMP))
SET ^BMXTMP($JOB,BMXFACP,BMXCOMP)="0^0^0"
+27 SET $PIECE(^BMXTMP($JOB,BMXFACP,BMXCOMP),U)=$PIECE(^(BMXCOMP),U)+BMXSVC
+28 SET $PIECE(^BMXTMP($JOB,BMXFACP,BMXCOMP),U,2)=$PIECE(^(BMXCOMP),U,2)+BMXMIN
+29 SET $PIECE(^BMXTMP($JOB,BMXFACP,BMXCOMP),U,3)=$PIECE(^(BMXCOMP),U,3)+BMXFEE
+30 QUIT
End DoDot:2
+31 QUIT
End DoDot:1
+32 ;
+33 ;Traverse ^BMXTMP and fill in ^BMXTEMP
+34 SET BMXI=0
+35 SET BMXFACP=-1
FOR
SET BMXFACP=$ORDER(^BMXTMP($JOB,BMXFACP))
IF BMXFACP=""
QUIT
Begin DoDot:1
+36 IF BMXFACP=0
SET BMXFAC="UNKNOWN"
+37 IF '$TEST
SET BMXFAC=$PIECE($GET(^DIC(4,BMXFACP,0)),U)
IF BMXFAC=""
SET BMXFAC="UNKNOWN"
+38 SET BMXCOMP=-1
FOR
SET BMXCOMP=$ORDER(^BMXTMP($JOB,BMXFACP,BMXCOMP))
IF BMXCOMP=""
QUIT
Begin DoDot:2
+39 IF BMXCOMP=0
SET BMXCOM="UNKNOWN"
+40 IF '$TEST
SET BMXCOM=$PIECE($GET(^AUTTCOM(BMXCOMP,0)),U)
IF BMXCOM=""
SET BMXCOM="UNKNOWN"
+41 SET BMXSU=+$PIECE($GET(^AUTTCOM(BMXCOMP,0)),U,5)
+42 IF BMXSU=0
SET BMXSU="UNKNOWN"
+43 IF '$TEST
SET BMXSU=$PIECE($GET(^AUTTSU(BMXSU,0)),U)
+44 SET BMXI=BMXI+1
+45 SET BMXSVC=$PIECE(^BMXTMP($JOB,BMXFACP,BMXCOMP),U)
+46 SET BMXMIN=$PIECE(^BMXTMP($JOB,BMXFACP,BMXCOMP),U,2)
+47 SET BMXFEE=$PIECE(^BMXTMP($JOB,BMXFACP,BMXCOMP),U,3)
+48 SET ^BMXTEMP($JOB,BMXI)=BMXFAC_U_BMXCOM_U_BMXSU_U_BMXSVC_U_BMXMIN_U_BMXFEE_BMXRD
+49 QUIT
End DoDot:2
+50 QUIT
End DoDot:1
+51 SET BMXI=BMXI+1
+52 SET ^BMXTEMP($JOB,BMXI)=$CHAR(31)
+53 QUIT
+54 ;
GETCOMP(BMXPAT) ;
+1 ;Returns Patient Community Pointer
+2 IF '$DATA(^AUPNPAT(BMXPAT,11))
QUIT 0
+3 QUIT +$PIECE(^AUPNPAT(BMXPAT,11),U,17)
+4 ;
CALCMIN(BMXIEN,BMXSVC,BMXMIN,BMXFEE) ;
+1 ;Returns count of lvl 1 - 6 services and minutes for entry BMXIEN
+2 ;Uses ANMC rogue FEE field in AUTTADA to calculate FEE data
+3 NEW BMXA,BMXCOD,BMXALVL
+4 SET BMXSVC=0
SET BMXMIN=0
SET BMXFEE=0
+5 IF '$DATA(^ADEPCD(BMXIEN,"ADA"))
QUIT
+6 SET BMXA=0
FOR
SET BMXA=$ORDER(^ADEPCD(BMXIEN,"ADA",BMXA))
IF '+BMXA
QUIT
Begin DoDot:1
+7 SET BMXCOD=+^ADEPCD(BMXIEN,"ADA",BMXA,0)
+8 IF '$DATA(^AUTTADA(BMXCOD,0))
QUIT
+9 SET BMXANOD=^AUTTADA(BMXCOD,0)
+10 SET BMXALVL=$PIECE(BMXANOD,U,5)
+11 IF BMXALVL=0
QUIT
+12 IF BMXALVL>6
QUIT
+13 SET BMXSVC=BMXSVC+1
+14 SET BMXMIN=BMXMIN+$PIECE(BMXANOD,U,4)
+15 SET BMXFEE=BMXFEE+$PIECE(BMXANOD,U,12)
End DoDot:1
+16 QUIT
