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

DGFFP03.m

Go to the documentation of this file. 
  1. DGFFP03 ; ALB/SCK - FUGITIVE FELON PROGRAM VISIT REPORT ; 11/14/2002
  1.  ;;5.3;Registration;**485**;Aug 13, 1993
  1.  ;
  1. QUE ;
  1.  N ZTSAVE,DGTMP,DIR,Y,DGEND,DGBEG,DIRUT,ZTRTN,ZTDESC,ZTDTH,ZTIO,%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 set 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 CURRENT STATUS REPORT"
  1.  S ZTRTN="RPT^DGFFP03"
  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.  S PAGE=1
  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 ;  Retrieve entire list of patient to print
  1.  N DGDFN,DFN,VAROOT,DGINP
  1.  ;
  1.  S DGDFN=0
  1.  F  S DGDFN=$O(^DPT("AXFFP",1,DGDFN)) Q:'DGDFN  D
  1.  . S DFN=DGDFN,VAROOT="DGINP"
  1.  . D INP^VADPT
  1.  . S ^TMP("DGFFP",$J,$S(+DGINP(1):"I",1:"O"),$$GET1^DIQ(2,DGDFN,.01),DGDFN)=""
  1.  . K DGINP
  1.  Q
  1.  ;
  1. GETLST(DGBEG,DGEND) ; Retrieve list of patients with the Fugitive Felon Flag set within specified date range
  1.  N DGDFN,DFN,VAROOT,DGINP,DGFFP
  1.  ;
  1.  S DGEND=$$FMADD^XLFDT(DGEND,1)
  1.  S DGDFN=0
  1.  F  S DGDFN=$O(^DPT("AXFFP",1,DGDFN)) Q:'DGDFN  D
  1.  . S DGFFP=$P($G(^DPT(DGDFN,"FFP")),U,3)
  1.  . I DGFFP>DGBEG&(DGFFP<DGEND) D
  1.  . . S DFN=DGDFN,VAROOT="DGINP"
  1.  . . D INP^VADPT
  1.  . . S ^TMP("DGFFP",$J,$S(+DGINP(1):"I",1:"O"),$$GET1^DIQ(2,DGDFN,.01),DGDFN)=""
  1.  . . K DGINP
  1.  Q
  1.  ;
  1. PRINT(DGBEG,DGEND) ; Print report
  1.  ;
  1.  D INPT(DGBEG,DGEND)
  1.  D OUTP(DGBEG,DGEND)
  1.  D SCHED(DGBEG,DGEND)
  1.  Q
  1.  ;
  1. INPT(DGBEG,DGEND) ;
  1.  N DGNAME,DFN,DGABRT,VA,DGAPT,TXT,DGSTAT
  1.  ;
  1.  D HDR(DGBEG,DGEND)
  1.  D INPHDR
  1.  ;
  1.  I '$D(^TMP("DGFFP",$J,"I")) W !!,"No Patients Found" Q
  1.  S DGNAME=""
  1.  F  S DGNAME=$O(^TMP("DGFFP",$J,"I",DGNAME)) Q:DGNAME']""  D  Q:$G(DGABRT)
  1.  . S DFN=0
  1.  . F  S DFN=$O(^TMP("DGFFP",$J,"I",DGNAME,DFN)) Q:'DFN  D  Q:$G(DGABRT)
  1.  . . D PID^VADPT6
  1.  . . S TXT=$E(DGNAME,1,$L(DGNAME))_" ("_VA("BID")_")" W !,TXT
  1.  . . D PRNINP(DFN)
  1.  . . D PRNSCRP(DFN)
  1.  . . D PRNRCNT(DFN)
  1.  . . W !
  1.  . . I (($Y+5)>IOSL) D
  1.  . . . I $$PAUSE^DGFFP02 S DGABRT=1 Q
  1.   .. . D HDR(DGBEG,DGEND),INPHDR
  1.  Q
  1.  ;
  1. OUTP(DGBEG,DGEND) ;
  1.  N DGNAME,DFN,DGABRT,VA,DGAPT,TXT,DGSTAT
  1.  ;       
  1.  D HDR(DGBEG,DGEND)
  1.  D OUTHDR
  1.  ;
  1.  I '$D(^TMP("DGFFP",$J,"O")) W !!,"No Patients Found" Q
  1.  S DGNAME=""
  1.  F  S DGNAME=$O(^TMP("DGFFP",$J,"O",DGNAME)) Q:DGNAME']""  D  Q:$G(DGABRT)
  1.  . S DFN=0
  1.  . F  S DFN=$O(^TMP("DGFFP",$J,"O",DGNAME,DFN)) Q:'DFN  D  Q:$G(DGABRT)
  1.  . . D PID^VADPT6
  1.  . . S TXT=$E(DGNAME,1,$L(DGNAME))_" ("_VA("BID")_")" W !,TXT
  1.  . . D PRNSCRP(DFN)
  1.  . . D PRNRCNT(DFN)
  1.  . . D PRNAPT(DFN)
  1.  . . W !
  1.  . . I (($Y+5)>IOSL) D
  1.  . . . I $$PAUSE^DGFFP02 S DGABRT=1 Q
  1.  . . . D HDR(DGBEG,DGEND),INPHDR
  1.  Q
  1.  ;
  1. SCHED(DGBEG,DGEND) ;
  1.  N DGNAME,DFN,DGABRT,VA,DGAPT,TXT,DGSTAT,TMPARY
  1.  ;       
  1.  D HDR(DGBEG,DGEND)
  1.  D FUHDR
  1.  ;
  1.  S DFN=0
  1.  F  S DFN=$O(^DPT("AXFFP",1,DFN)) Q:'DFN  D
  1.  . S ^TMP("DGFFP",$J,"F",$$GET1^DIQ(2,DFN,.01),DFN)=""
  1.  ;
  1.  S DGNAME=""
  1.  F  S DGNAME=$O(^TMP("DGFFP",$J,"F",DGNAME)) Q:DGNAME']""  D  Q:$G(DGABRT)
  1.  . S DFN=0
  1.  . F  S DFN=$O(^TMP("DGFFP",$J,"F",DGNAME,DFN)) Q:'DFN  D  Q:$G(DGABRT)
  1.  . . S TMPARY="^TMP(""DGFFPF"",$J)" K @TMPARY
  1.  . . D GETFUADM(DFN,TMPARY)
  1.  . . Q:'$D(@TMPARY)
  1.  . . D PID^VADPT6
  1.  . . S TXT=$E(DGNAME,1,$L(DGNAME))_" ("_VA("BID")_")" W !,TXT
  1.  . . D PRNSCRP(DFN)
  1.  . . D PRNRCNT(DFN)
  1.  . . D PRNFUT(TMPARY)
  1.  . . K @TMPARY
  1.  Q
  1.  ;
  1. PRNFUT(TMPARY) ;
  1.  N DGDT,DGWARD
  1.  ;
  1.  S DGDT=0
  1.  F  S DGDT=$O(@TMPARY@(DGDT)) Q:'DGDT  D
  1.  . W !?40,$$FMTE^XLFDT(DGDT,"1P")
  1.  . S DGWARD=$P(@TMPARY@(DGDT),U,8)
  1.  . W ?80,$$GET1^DIQ(42,DGWARD,.01)
  1.  Q
  1.  ;
  1. PRNSCRP(DFN) ; Print Active Script Information
  1.  N DGSCRPT
  1.  ;
  1.  S DGSCRPT=$$GET1^DIQ(55,DFN,50)
  1.  W ?110,$S(DGSCRPT>0:DGSCRPT,1:"None")
  1.  Q
  1.  ;
  1. PRNINP(DFN) ; Print Inpatient Information
  1.  N VAROOT,DGIN
  1.  ;
  1.  S VAROOT="DGIN"
  1.  D IN5^VADPT
  1.  W ?40,$P(DGIN(2),U,2)
  1.  W ?55,$$FMTE^XLFDT($P(DGIN(3),U,1),"D")
  1.  W ?70,$P(DGIN(6),U,2)
  1.  W ?80,$P(DGIN(5),U,2)
  1.  Q
  1.  ;
  1. PRNRCNT(DFN) ;  Print most recent activity
  1.  N DGLAST
  1.  ;
  1.  S DGLAST=$$LASTACT^DGFFPLM(DFN)
  1.  I DGLAST]"" D
  1.  . W !?3,">> "_DGLAST
  1.  Q
  1.  ;
  1. PRNAPT(DFN) ;  Print Future Appointment information
  1.  N LINE,DGRTN,DGCLN,DGDT,TEMP
  1.  ;
  1.  S TEMP="^TMP(""VASD"",$J)"
  1.  K @TEMP
  1.  D GETAPT(DFN,TEMP)
  1.  S DGCLN=""
  1.  F  S DGCLN=$O(@TEMP@(DGCLN)) Q:DGCLN']""  D  Q:$G(RSLT)
  1.  . W !?40,DGCLN
  1.  . S DGDT=0
  1.  . F  S DGDT=$O(@TEMP@(DGCLN,DGDT)) Q:'DGDT  D  Q:$G(RSLT)
  1.  . . W ?70,$$FMTE^XLFDT(DGDT,"1P"),!
  1.  K @TEMP
  1.  Q
  1.  ;
  1. GETAPT(DFN,TEMP) ; Sort Clinic appointments by clinic
  1.  N LINE,VAROOT,VASD,DGAPT
  1.  ;
  1.  D SDA^VADPT
  1.  S DGAPT="^UTILITY(""VASD"",$J)"
  1.  S LINE=0
  1.  F  S LINE=$O(@DGAPT@(LINE)) Q:'LINE  D
  1.  . S @TEMP@($P(@DGAPT@(LINE,"E"),U,2),$P(@DGAPT@(LINE,"I"),U,1))=$P(@DGAPT@(LINE,"E"),U,3)
  1.  K @DGAPT
  1.  Q
  1.  ;
  1. GETFUADM(DFN,TMPARY) ; Get future scheduled admissions
  1.  N DGIEN,DGNODE
  1.  ;
  1.  S DGIEN=0
  1.  F  S DGIEN=$O(^DGS(41.1,"B",DFN,DGIEN)) Q:'DGIEN  D
  1.  . S DGNODE=$G(^DGS(41.1,DGIEN,0))
  1.  . S @TMPARY@($P(DGNODE,U,2))=DGNODE
  1.  Q
  1.  ;
  1. HDR(DGBEG,DGEND) ;
  1.  N LINE,TXT,SPACE
  1.  ;
  1.  I $E(IOST,1,2)="C-"!($G(PAGE)>1) W @IOF
  1.  S TXT="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 TXT="Page: "_PAGE
  1.  S SPACE=(IOM-$L(TXT))/2
  1.  W !?SPACE,TXT
  1.  S PAGE=PAGE+1
  1.  Q
  1.  ;
  1. INPHDR ;
  1.  N TXT,LINE,SPACE
  1.  ;
  1.  S TXT="Inpatient Listing"
  1.  S SPACE=(IOM-$L(TXT))/2
  1.  W !?SPACE,TXT
  1.  ;
  1.  W !!,"Patient Name",?40,"Movement",?55,"Date",?70,"Room/Bed",?80,"Ward",?110,"Active Scripts?"
  1.  S $P(LINE,"=",IOM)="" W !,LINE
  1.  Q
  1.  ;
  1. OUTHDR ;
  1.  N TXT,LINE,SPACE
  1.  ;
  1.  S TXT="Outpatient Listing"
  1.  S SPACE=(IOM-$L(TXT))/2
  1.  W !?SPACE,TXT
  1.  ;
  1.  W !!,"Patient Name",?40,"Clinic",?70,"Appt. D/T",?110,"Active Scripts?"
  1.  S $P(LINE,"=",IOM)="" W !,LINE
  1.  Q
  1.  ;
  1. FUHDR ;
  1.  N TXT,LINE,SPACE
  1.  ;
  1.  S TXT="Future Scheduled Admissions"
  1.  S SPACE=(IOM-$L(TXT))/2
  1.  W !?SPACE,TXT
  1.  ;
  1.  W !!,"Patient Name",?40,"Scheduled Admission",?80,"Ward",?110,"Active Scripts?"
  1.  S $P(LINE,"=",IOM)="" W !,LINE
  1.  Q