source: BMXNET_RPMS_dotNET_UTILITIES-BMX/branch/BMX41000/routines/BMXADE1.m@ 1589

Last change on this file since 1589 was 1147, checked in by Sam Habiel, 14 years ago

Mumps Routines 4 BMX4
File size: 3.0 KB
Line 
1BMXADE1 ; IHS/OIT/HMW - BMXNet ADO.NET PROVIDER ;
2 ;;4.1000;BMX;;Apr 17, 2011
3 ;
4 ;
5 ;Dental Excel report demo
6 ;
7BMXADE(BMXGBL,BMXBEG,BMXEND) ;EP
8 ;Returns recordset containing services and minutes by reporting facility, patient's community and service unit
9 ;
10 N BMXBEGDT,BMXENDDT,BMXTMP,BMXDT,BMXRD,BMXIEN,BMXNOD,BMXPAT,BMXCOM,BMXFAC,BMXSU,BMXCOMP,BMXSUP,BMXFACP,BMXSVC,BMXMIN,BMXFEE
11 S U="^",BMXRD=$C(30)
12 K ^BMXTEMP($J),^BMXTMP($J)
13 S BMXGBL="^BMXTEMP("_$J_")"
14 S ^BMXTEMP($J,0)="T00030FACILITY^T00030PT_COMMUNITY^T00030PT_SERVICE_UNIT^I00030SERVICES^I00030MINUTES^I00030FEE"_BMXRD
15 S X=BMXBEG,%DT="P" D ^%DT S BMXBEGDT=Y
16 S X=BMXEND,%DT="P" D ^%DT S BMXENDDT=Y
17 I BMXENDDT<BMXBEGDT S BMXTMP=BMXENDDT,BMXENDDT=BMXBEGDT,BMXBEGDT=BMXTMP
18 S BMXBEGDT=$P(BMXBEGDT,".")
19 S BMXENDDT=$P(BMXENDDT,"."),$P(BMXENDDT,".",2)=99999
20 ;
21 ;$O Thru ADEPCD("AC" DATE X-REF
22 ;Temp global is (FAC,COMM)=SVCS^MINS
23 ;
24 S BMXDT=BMXBEGDT F S BMXDT=$O(^ADEPCD("AC",BMXDT)) Q:'+BMXDT Q:BMXDT>BMXENDDT D
25 . S BMXIEN=0 F S BMXIEN=$O(^ADEPCD("AC",BMXDT,BMXIEN)) Q:'+BMXIEN D
26 . . Q:'$D(^ADEPCD(BMXIEN,0))
27 . . S BMXNOD=^ADEPCD(BMXIEN,0)
28 . . S BMXPAT=$P(BMXNOD,U)
29 . . S BMXFACP=+$P(BMXNOD,U,3)
30 . . S BMXCOMP=$$GETCOMP(BMXPAT)
31 . . D CALCMIN(BMXIEN,.BMXSVC,.BMXMIN,.BMXFEE)
32 . . Q:BMXSVC=0
33 . . S:'$D(^BMXTMP($J,BMXFACP,BMXCOMP)) ^BMXTMP($J,BMXFACP,BMXCOMP)="0^0^0"
34 . . S $P(^BMXTMP($J,BMXFACP,BMXCOMP),U)=$P(^(BMXCOMP),U)+BMXSVC
35 . . S $P(^BMXTMP($J,BMXFACP,BMXCOMP),U,2)=$P(^(BMXCOMP),U,2)+BMXMIN
36 . . S $P(^BMXTMP($J,BMXFACP,BMXCOMP),U,3)=$P(^(BMXCOMP),U,3)+BMXFEE
37 . . Q
38 . Q
39 ;
40 ;Traverse ^BMXTMP and fill in ^BMXTEMP
41 S BMXI=0
42 S BMXFACP=-1 F S BMXFACP=$O(^BMXTMP($J,BMXFACP)) Q:BMXFACP="" D
43 . I BMXFACP=0 S BMXFAC="UNKNOWN"
44 . E S BMXFAC=$P($G(^DIC(4,BMXFACP,0)),U) S:BMXFAC="" BMXFAC="UNKNOWN"
45 . S BMXCOMP=-1 F S BMXCOMP=$O(^BMXTMP($J,BMXFACP,BMXCOMP)) Q:BMXCOMP="" D
46 . . I BMXCOMP=0 S BMXCOM="UNKNOWN"
47 . . E S BMXCOM=$P($G(^AUTTCOM(BMXCOMP,0)),U) S:BMXCOM="" BMXCOM="UNKNOWN"
48 . . S BMXSU=+$P($G(^AUTTCOM(BMXCOMP,0)),U,5)
49 . . I BMXSU=0 S BMXSU="UNKNOWN"
50 . . E S BMXSU=$P($G(^AUTTSU(BMXSU,0)),U)
51 . . S BMXI=BMXI+1
52 . . S BMXSVC=$P(^BMXTMP($J,BMXFACP,BMXCOMP),U)
53 . . S BMXMIN=$P(^BMXTMP($J,BMXFACP,BMXCOMP),U,2)
54 . . S BMXFEE=$P(^BMXTMP($J,BMXFACP,BMXCOMP),U,3)
55 . . S ^BMXTEMP($J,BMXI)=BMXFAC_U_BMXCOM_U_BMXSU_U_BMXSVC_U_BMXMIN_U_BMXFEE_BMXRD
56 . . Q
57 . Q
58 S BMXI=BMXI+1
59 S ^BMXTEMP($J,BMXI)=$C(31)
60 Q
61 ;
62GETCOMP(BMXPAT) ;
63 ;Returns Patient Community Pointer
64 I '$D(^AUPNPAT(BMXPAT,11)) Q 0
65 Q +$P(^AUPNPAT(BMXPAT,11),U,17)
66 ;
67CALCMIN(BMXIEN,BMXSVC,BMXMIN,BMXFEE) ;
68 ;Returns count of lvl 1 - 6 services and minutes for entry BMXIEN
69 ;Uses ANMC rogue FEE field in AUTTADA to calculate FEE data
70 N BMXA,BMXCOD,BMXALVL
71 S BMXSVC=0,BMXMIN=0,BMXFEE=0
72 Q:'$D(^ADEPCD(BMXIEN,"ADA"))
73 S BMXA=0 F S BMXA=$O(^ADEPCD(BMXIEN,"ADA",BMXA)) Q:'+BMXA D
74 . S BMXCOD=+^ADEPCD(BMXIEN,"ADA",BMXA,0)
75 . Q:'$D(^AUTTADA(BMXCOD,0))
76 . S BMXANOD=^AUTTADA(BMXCOD,0)
77 . S BMXALVL=$P(BMXANOD,U,5)
78 . Q:BMXALVL=0
79 . Q:BMXALVL>6
80 . S BMXSVC=BMXSVC+1
81 . S BMXMIN=BMXMIN+$P(BMXANOD,U,4)
82 . S BMXFEE=BMXFEE+$P(BMXANOD,U,12)
83 Q
Note: See TracBrowser for help on using the repository browser.