- 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
