| 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 | 
|---|