TMGMISC ;TMG/kst/Misc Reports;05/01/09
         ;;1.0;TMG-LIB;**1**;05/01/09

 ;"TMG MISCELLANEOUS FUNCTIONS
 ;"Kevin Toppenberg MD
 ;"GNU General Public License (GPL) applies
 ;"5/1/09


 ;"=======================================================================
 ;" API -- Public Functions.
 ;"=======================================================================
 ;"DEVMAMRPT -- Provide an interactive entry point for report, asking device.
 ;"MAMMORPT --Show report of outstanding consults and extract schedule date from them


 ;"=======================================================================
 ;"PRIVATE API FUNCTIONS
 ;"=======================================================================

ASKDEVRPT
       ;"Purpose: Provide an interactive entry point for report, asking device.
       new %ZIS
       set %ZIS("A")="Enter Output Device: "
       set %ZIS("B")="HOME"
       do ^%ZIS  ;"standard device call
       if POP do  goto DMRDn
       . do ShowError^TMGDEBUG(.PriorErrorFound,"Error opening output.  Aborting.")
       use IO
       do MAMMORPT
       do ^%ZISC  ;" Close the output device
       do PressToCont^TMGUSRIF
DMRDn  quit

DEVMAMRPT
       ;"Purpose: Provide an interactive entry point for report, asking device.
       new %ZIS,IOP
       set IOP="S121-LAUGHLIN-LASER"
       do ^%ZIS  ;"standard device call
       if POP do  goto AMRDn
       . do ShowError^TMGDEBUG(.PriorErrorFound,"Error opening output.  Aborting.")
       use IO
       do MAMMORPT
       do ^%ZISC  ;" Close the output device
AMRDn  quit

MAMMORPT
       ;"Purpose: Show report of outstanding consults and extract schedule date from them.
       ;"Results: None, but report created.
       new MammoIEN set MammoIEN=+$order(^GMR(123.5,"B","MAMMOGRAM",""))
       if MammoIEN'>0 do  goto MRPTDn
       . write "Can't locate record for MAMMOGRAM report.  Aborting.",!
       new ComplIEN set ComplIEN=+$order(^ORD(100.01,"B","COMPLETE",""))
       if ComplIEN'>0 do  goto MRPTDn
       . write "Can't find record for COMPLETE status.  Aborting.",!
       new X,Y do NOW^%DTC new NowDate set NowDate=X
       ;
       write !
       write "************************************************************",!
       write "              Outstanding mammograms report",!
       write "                     " set Y=X do DD^%DT write Y,!
       write "          Please deliver this report to the nurse",!
       write "************************************************************",!
       write "                                            (From TMGRPT1.m)",!!
       new idx set idx=""
       new matches
       for  set idx=+$order(^GMR(123,"C",MammoIEN,idx)) quit:(idx'>0)  do
       . new s
       . new znode set znode=$get(^GMR(123,idx,0))
       . new status set status=$piece(znode,"^",12)
       . if status=ComplIEN quit
       . new Y set Y=$piece(znode,"^",7)  ;"date of request
       . do DD^%DT set s=Y
       . new PtIEN set PtIEN=+$piece(znode,"^",2)
       . if PtIEN'=0 do
       . . set s=s_"^"_$piece($get(^DPT(PtIEN,0)),"^",1)
       . else  do
       . . set s=s_"^"_"?? Patient Name not found.  Record # "_idx_" in file #123"
       . ;"Now scan for appt scheduled date
       . new idxWP set idxWP=0
       . new found set found=0
       . for  set idxWP=+$order(^GMR(123,idx,20,idxWP)) quit:(idxWP'>0)!found  do
       . . new line set line=$get(^GMR(123,idx,20,idxWP,0)) quit:line=""
       . . if line'["Scheduled Appointment:" quit
       . . set found=1
       . . new apptDate set apptDate=$piece(line,"Scheduled Appointment:",2)
       . . set Y=$$FMDate^TMGFMUT(apptDate)
       . . new FMDate set FMDate=Y
       . . if Y>0 do
       . . . do DD^%DT  ;"standardize date
       . . else  do
       . . . set Y=apptDate
       . . set s=s_"^"_Y
       . . set matches(FMDate)=s
       ;
       new future set future=0
       new dueDate set dueDate=""
       for  set dueDate=$order(matches(dueDate),1) quit:(dueDate="")  do
       . if (dueDate>NowDate)&(future=0) do
       . . set future=1
       . . write "-----------------------------------------------------------------------------",!
       . new s set s=matches(dueDate)
       . write "Due: ",$p(s,"^",3),?25,$p(s,"^",2),?50,"Made on visit: ",$p($p(s,"^",1),"@",1),!

MRPTDn quit