| [796] | 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
|
|---|
