Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: DGFFP04

DGFFP04.m

Go to the documentation of this file. 
  1. DGFFP04 ;ALB/SCK - FUGITIVE FELON PROGRAM CLEARED REPORT 12/5/02
  1.  ;;5.3;Registration;**485**;Aug 13, 1993
  1.  ;
  1. QUE ;
  1.  N ZTSAVE,DGTMP,DIR,Y,DGEND,DGBEG,DIRUT,ZTRTN,ZTDESC,ZTDTH,ZTIO,POP,IO,ZTSK,%ZIS
  1.  ;
  1.  S DIR(0)="YAO",DIR("B")="YES",DIR("A")="Print report by date range? "
  1.  S DIR("?",1)="Enter 'YES' to print the report showing those patients for whom the"
  1.  S DIR("?",2)="flag was cleared within a specific date range."
  1.  S DIR("?")="Enter 'NO' to print for all dates."
  1.  D ^DIR K DIR
  1.  Q:$D(DIRUT)
  1.  I '+Y S (DGBEG,DGEND)=0
  1.  E  D GETDT^DGFFP02(.DGBEG,.DGEND)
  1.  ;
  1.  W !,$CHAR(7)
  1.  W !?5,">> This report requires a 132-column printer"
  1.  S %ZIS="Q" D ^%ZIS G EXIT:POP
  1.  I $D(IO("Q")) D START Q
  1.  D RPT,^%ZISC
  1.  Q
  1.  ;
  1. START ;
  1.  S ZTDTH=$$NOW^XLFDT
  1.  S ZTSAVE("DGBEG")="",ZTSAVE("DGEND")=""
  1.  S ZTDESC="DGFFP CLEARED FF FLAG REPORT"
  1.  S ZTRTN="RPT^DGFFP04"
  1.  D ^%ZTLOAD
  1.  I $D(ZTSK)[0 W !!?5,"Report canceled"
  1.  E  W !!?5,"Report Queued"
  1. EXIT D HOME^%ZIS
  1.  Q
  1.  ;
  1. RPT ;
  1.  N PAGE
  1.  ;
  1.  U IO
  1.  K ^TMP("DGFFP",$J)
  1.  ;
  1.  I +DGBEG>0 D GETLST(DGBEG,DGEND)
  1.  E  D GETALL
  1.  ;
  1.  D PRINT(DGBEG,DGEND)
  1.  K ^TMP("DGFFP",$J)
  1.  D ^%ZISC
  1.  Q
  1.  ;
  1. GETALL ;
  1.  N DGIEN,DGDFN
  1.  ;
  1.  S DGDFN=0
  1.  F  S DGDFN=$O(^DPT(DGDFN)) Q:'DGDFN  D
  1.  . Q:'$D(^DPT(DGDFN,"FFP"))
  1.  . Q:$D(^DPT("AXFFP",1,DGDFN))
  1.  . S ^TMP("DGFFP",$J,$P($G(^DPT(DGDFN,0)),U,1),DGDFN)=$G(^("FFP"))
  1.  Q
  1.  ;
  1. GETLST(DGBEG,DGEND) ; Retreive cleared FF Flags by date range (date cleared)
  1.  N DGDFN,DGFFP
  1.  ;
  1.  S DGDFN=0
  1.  S DGEND=$$FMADD^XLFDT(DGEND,1)
  1.  F  S DGDFN=$O(^DPT(DGDFN)) Q:'DGDFN  D
  1.  . Q:'$D(^DPT(DGDFN,"FFP"))
  1.  . Q:$D(^DPT("AXFFP",1,DGDFN))
  1.  . S DGFFP=$G(^DPT(DGDFN,"FFP"))
  1.  . I $P(DGFFP,U,5)>DGBEG&($P(DGFFP,U,5)<DGEND) D
  1.  . . S ^TMP("DGFFP",$J,$$GET1^DIQ(2,DGDFN,.01),DGDFN)=DGFFP
  1.  Q
  1.  ;
  1. PRINT(DGBEG,DGEND) ;
  1.  N DFN,VA,TXT,DGNAME,DGABRT,DGNODE,PAGE
  1.  ;
  1.  S PAGE=0
  1.  D HDR(DGBEG,DGEND)
  1.  S DGNAME=""
  1.  F  S DGNAME=$O(^TMP("DGFFP",$J,DGNAME)) Q:DGNAME']""  D  Q:$G(DGABRT)
  1.  . S DFN=0
  1.  . F  S DFN=$O(^TMP("DGFFP",$J,DGNAME,DFN)) Q:'DFN  D  Q:$G(DGABRT)
  1.  . . D PID^VADPT6
  1.  . . S TXT=$E(DGNAME,1,$L(DGNAME))_" ("_VA("BID")_")"
  1.  . . W !,TXT
  1.  . . S DGNODE=^TMP("DGFFP",$J,DGNAME,DFN)
  1.  . . W ?40,$$FMTE^XLFDT($P(DGNODE,U,3),"2D")
  1.  . . W ?50,$$GET1^DIQ(200,$P(DGNODE,U,2),.01)
  1.  . . W ?80,$$FMTE^XLFDT($P(DGNODE,U,5),"2D")
  1.  . . W ?90,$$GET1^DIQ(200,$P(DGNODE,U,4),.01)
  1.  . . W !?5,$P(DGNODE,U,9)
  1.  Q
  1.  ;
  1. HDR(DGBEG,DGEND) ;
  1.  N LINE,TXT,SPACE
  1.  ;
  1.  I $E(IOST,1,2)="C-" W @IOF
  1.  S TXT="Cleared Fugitive Felon Status Report"
  1.  S SPACE=(IOM-$L(TXT))/2
  1.  W !?SPACE,TXT
  1.  ;
  1.  I DGBEG>0 D
  1.  . S TXT="Report Date Range: "_$$FMTE^XLFDT(DGBEG)_" to "_$$FMTE^XLFDT(DGEND)
  1.  . S SPACE=(IOM-$L(TXT))/2
  1.  . W !?SPACE,TXT
  1.  ;
  1.  S TXT="Print Date: "_$$FMTE^XLFDT($$NOW^XLFDT)
  1.  S SPACE=(IOM-$L(TXT))/2
  1.  W !?SPACE,TXT
  1.  ;
  1.  S PAGE=PAGE+1
  1.  S TXT="Page: "_PAGE
  1.  S SPACE=(IOM-$L(TXT))/2
  1.  W !?SPACE,TXT
  1.  ;
  1.  W !!,"Patient Name",?40,"Entered",?50,"Who Entered",?80,"Cleared",?90,"Who Cleared"
  1.  S $P(LINE,"=",IOM)="" W !,LINE
  1.  Q