1 | TMGMISC ;TMG/kst/Misc Reports;05/01/09
|
---|
2 | ;;1.0;TMG-LIB;**1**;05/01/09
|
---|
3 |
|
---|
4 | ;"TMG MISCELLANEOUS FUNCTIONS
|
---|
5 | ;"Kevin Toppenberg MD
|
---|
6 | ;"GNU General Public License (GPL) applies
|
---|
7 | ;"5/1/09
|
---|
8 |
|
---|
9 |
|
---|
10 | ;"=======================================================================
|
---|
11 | ;" API -- Public Functions.
|
---|
12 | ;"=======================================================================
|
---|
13 | ;"DEVMAMRPT -- Provide an interactive entry point for report, asking device.
|
---|
14 | ;"MAMMORPT --Show report of outstanding consults and extract schedule date from them
|
---|
15 |
|
---|
16 |
|
---|
17 | ;"=======================================================================
|
---|
18 | ;"PRIVATE API FUNCTIONS
|
---|
19 | ;"=======================================================================
|
---|
20 |
|
---|
21 | ASKDEVRPT
|
---|
22 | ;"Purpose: Provide an interactive entry point for report, asking device.
|
---|
23 | new %ZIS
|
---|
24 | set %ZIS("A")="Enter Output Device: "
|
---|
25 | set %ZIS("B")="HOME"
|
---|
26 | do ^%ZIS ;"standard device call
|
---|
27 | if POP do goto DMRDn
|
---|
28 | . do ShowError^TMGDEBUG(.PriorErrorFound,"Error opening output. Aborting.")
|
---|
29 | use IO
|
---|
30 | do MAMMORPT
|
---|
31 | do ^%ZISC ;" Close the output device
|
---|
32 | do PressToCont^TMGUSRIF
|
---|
33 | DMRDn quit
|
---|
34 |
|
---|
35 | DEVMAMRPT
|
---|
36 | ;"Purpose: Provide an interactive entry point for report, asking device.
|
---|
37 | new %ZIS,IOP
|
---|
38 | set IOP="S121-LAUGHLIN-LASER"
|
---|
39 | do ^%ZIS ;"standard device call
|
---|
40 | if POP do goto AMRDn
|
---|
41 | . do ShowError^TMGDEBUG(.PriorErrorFound,"Error opening output. Aborting.")
|
---|
42 | use IO
|
---|
43 | do MAMMORPT
|
---|
44 | do ^%ZISC ;" Close the output device
|
---|
45 | AMRDn quit
|
---|
46 |
|
---|
47 | MAMMORPT
|
---|
48 | ;"Purpose: Show report of outstanding consults and extract schedule date from them.
|
---|
49 | ;"Results: None, but report created.
|
---|
50 | new MammoIEN set MammoIEN=+$order(^GMR(123.5,"B","MAMMOGRAM",""))
|
---|
51 | if MammoIEN'>0 do goto MRPTDn
|
---|
52 | . write "Can't locate record for MAMMOGRAM report. Aborting.",!
|
---|
53 | new ComplIEN set ComplIEN=+$order(^ORD(100.01,"B","COMPLETE",""))
|
---|
54 | if ComplIEN'>0 do goto MRPTDn
|
---|
55 | . write "Can't find record for COMPLETE status. Aborting.",!
|
---|
56 | new X,Y do NOW^%DTC new NowDate set NowDate=X
|
---|
57 | ;
|
---|
58 | write !
|
---|
59 | write "************************************************************",!
|
---|
60 | write " Outstanding mammograms report",!
|
---|
61 | write " " set Y=X do DD^%DT write Y,!
|
---|
62 | write " Please deliver this report to the nurse",!
|
---|
63 | write "************************************************************",!
|
---|
64 | write " (From TMGRPT1.m)",!!
|
---|
65 | new idx set idx=""
|
---|
66 | new matches
|
---|
67 | for set idx=+$order(^GMR(123,"C",MammoIEN,idx)) quit:(idx'>0) do
|
---|
68 | . new s
|
---|
69 | . new znode set znode=$get(^GMR(123,idx,0))
|
---|
70 | . new status set status=$piece(znode,"^",12)
|
---|
71 | . if status=ComplIEN quit
|
---|
72 | . new Y set Y=$piece(znode,"^",7) ;"date of request
|
---|
73 | . do DD^%DT set s=Y
|
---|
74 | . new PtIEN set PtIEN=+$piece(znode,"^",2)
|
---|
75 | . if PtIEN'=0 do
|
---|
76 | . . set s=s_"^"_$piece($get(^DPT(PtIEN,0)),"^",1)
|
---|
77 | . else do
|
---|
78 | . . set s=s_"^"_"?? Patient Name not found. Record # "_idx_" in file #123"
|
---|
79 | . ;"Now scan for appt scheduled date
|
---|
80 | . new idxWP set idxWP=0
|
---|
81 | . new found set found=0
|
---|
82 | . for set idxWP=+$order(^GMR(123,idx,20,idxWP)) quit:(idxWP'>0)!found do
|
---|
83 | . . new line set line=$get(^GMR(123,idx,20,idxWP,0)) quit:line=""
|
---|
84 | . . if line'["Scheduled Appointment:" quit
|
---|
85 | . . set found=1
|
---|
86 | . . new apptDate set apptDate=$piece(line,"Scheduled Appointment:",2)
|
---|
87 | . . set Y=$$FMDate^TMGFMUT(apptDate)
|
---|
88 | . . new FMDate set FMDate=Y
|
---|
89 | . . if Y>0 do
|
---|
90 | . . . do DD^%DT ;"standardize date
|
---|
91 | . . else do
|
---|
92 | . . . set Y=apptDate
|
---|
93 | . . set s=s_"^"_Y
|
---|
94 | . . set matches(FMDate)=s
|
---|
95 | ;
|
---|
96 | new future set future=0
|
---|
97 | new dueDate set dueDate=""
|
---|
98 | for set dueDate=$order(matches(dueDate),1) quit:(dueDate="") do
|
---|
99 | . if (dueDate>NowDate)&(future=0) do
|
---|
100 | . . set future=1
|
---|
101 | . . write "-----------------------------------------------------------------------------",!
|
---|
102 | . new s set s=matches(dueDate)
|
---|
103 | . write "Due: ",$p(s,"^",3),?25,$p(s,"^",2),?50,"Made on visit: ",$p($p(s,"^",1),"@",1),!
|
---|
104 |
|
---|
105 | MRPTDn quit
|
---|