source: cprs/branches/tmg-cprs/m_files/TMGRPT1.m

Last change on this file was 796, checked in by Kevin Toppenberg, 14 years ago

Initial upload

File size: 4.2 KB
Line 
1TMGMISC ;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
21ASKDEVRPT
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
33DMRDn quit
34
35DEVMAMRPT
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
45AMRDn quit
46
47MAMMORPT
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
105MRPTDn quit
Note: See TracBrowser for help on using the repository browser.