[613] | 1 | DGFFP04 ;ALB/SCK - FUGITIVE FELON PROGRAM CLEARED REPORT 12/5/02
|
---|
| 2 | ;;5.3;Registration;**485**;Aug 13, 1993
|
---|
| 3 | ;
|
---|
| 4 | QUE ;
|
---|
| 5 | N ZTSAVE,DGTMP,DIR,Y,DGEND,DGBEG,DIRUT,ZTRTN,ZTDESC,ZTDTH,ZTIO,POP,IO,ZTSK,%ZIS
|
---|
| 6 | ;
|
---|
| 7 | S DIR(0)="YAO",DIR("B")="YES",DIR("A")="Print report by date range? "
|
---|
| 8 | S DIR("?",1)="Enter 'YES' to print the report showing those patients for whom the"
|
---|
| 9 | S DIR("?",2)="flag was cleared within a specific date range."
|
---|
| 10 | S DIR("?")="Enter 'NO' to print for all dates."
|
---|
| 11 | D ^DIR K DIR
|
---|
| 12 | Q:$D(DIRUT)
|
---|
| 13 | I '+Y S (DGBEG,DGEND)=0
|
---|
| 14 | E D GETDT^DGFFP02(.DGBEG,.DGEND)
|
---|
| 15 | ;
|
---|
| 16 | W !,$CHAR(7)
|
---|
| 17 | W !?5,">> This report requires a 132-column printer"
|
---|
| 18 | S %ZIS="Q" D ^%ZIS G EXIT:POP
|
---|
| 19 | I $D(IO("Q")) D START Q
|
---|
| 20 | D RPT,^%ZISC
|
---|
| 21 | Q
|
---|
| 22 | ;
|
---|
| 23 | START ;
|
---|
| 24 | S ZTDTH=$$NOW^XLFDT
|
---|
| 25 | S ZTSAVE("DGBEG")="",ZTSAVE("DGEND")=""
|
---|
| 26 | S ZTDESC="DGFFP CLEARED FF FLAG REPORT"
|
---|
| 27 | S ZTRTN="RPT^DGFFP04"
|
---|
| 28 | D ^%ZTLOAD
|
---|
| 29 | I $D(ZTSK)[0 W !!?5,"Report canceled"
|
---|
| 30 | E W !!?5,"Report Queued"
|
---|
| 31 | EXIT D HOME^%ZIS
|
---|
| 32 | Q
|
---|
| 33 | ;
|
---|
| 34 | RPT ;
|
---|
| 35 | N PAGE
|
---|
| 36 | ;
|
---|
| 37 | U IO
|
---|
| 38 | K ^TMP("DGFFP",$J)
|
---|
| 39 | ;
|
---|
| 40 | I +DGBEG>0 D GETLST(DGBEG,DGEND)
|
---|
| 41 | E D GETALL
|
---|
| 42 | ;
|
---|
| 43 | D PRINT(DGBEG,DGEND)
|
---|
| 44 | K ^TMP("DGFFP",$J)
|
---|
| 45 | D ^%ZISC
|
---|
| 46 | Q
|
---|
| 47 | ;
|
---|
| 48 | GETALL ;
|
---|
| 49 | N DGIEN,DGDFN
|
---|
| 50 | ;
|
---|
| 51 | S DGDFN=0
|
---|
| 52 | F S DGDFN=$O(^DPT(DGDFN)) Q:'DGDFN D
|
---|
| 53 | . Q:'$D(^DPT(DGDFN,"FFP"))
|
---|
| 54 | . Q:$D(^DPT("AXFFP",1,DGDFN))
|
---|
| 55 | . S ^TMP("DGFFP",$J,$P($G(^DPT(DGDFN,0)),U,1),DGDFN)=$G(^("FFP"))
|
---|
| 56 | Q
|
---|
| 57 | ;
|
---|
| 58 | GETLST(DGBEG,DGEND) ; Retreive cleared FF Flags by date range (date cleared)
|
---|
| 59 | N DGDFN,DGFFP
|
---|
| 60 | ;
|
---|
| 61 | S DGDFN=0
|
---|
| 62 | S DGEND=$$FMADD^XLFDT(DGEND,1)
|
---|
| 63 | F S DGDFN=$O(^DPT(DGDFN)) Q:'DGDFN D
|
---|
| 64 | . Q:'$D(^DPT(DGDFN,"FFP"))
|
---|
| 65 | . Q:$D(^DPT("AXFFP",1,DGDFN))
|
---|
| 66 | . S DGFFP=$G(^DPT(DGDFN,"FFP"))
|
---|
| 67 | . I $P(DGFFP,U,5)>DGBEG&($P(DGFFP,U,5)<DGEND) D
|
---|
| 68 | . . S ^TMP("DGFFP",$J,$$GET1^DIQ(2,DGDFN,.01),DGDFN)=DGFFP
|
---|
| 69 | Q
|
---|
| 70 | ;
|
---|
| 71 | PRINT(DGBEG,DGEND) ;
|
---|
| 72 | N DFN,VA,TXT,DGNAME,DGABRT,DGNODE,PAGE
|
---|
| 73 | ;
|
---|
| 74 | S PAGE=0
|
---|
| 75 | D HDR(DGBEG,DGEND)
|
---|
| 76 | S DGNAME=""
|
---|
| 77 | F S DGNAME=$O(^TMP("DGFFP",$J,DGNAME)) Q:DGNAME']"" D Q:$G(DGABRT)
|
---|
| 78 | . S DFN=0
|
---|
| 79 | . F S DFN=$O(^TMP("DGFFP",$J,DGNAME,DFN)) Q:'DFN D Q:$G(DGABRT)
|
---|
| 80 | . . D PID^VADPT6
|
---|
| 81 | . . S TXT=$E(DGNAME,1,$L(DGNAME))_" ("_VA("BID")_")"
|
---|
| 82 | . . W !,TXT
|
---|
| 83 | . . S DGNODE=^TMP("DGFFP",$J,DGNAME,DFN)
|
---|
| 84 | . . W ?40,$$FMTE^XLFDT($P(DGNODE,U,3),"2D")
|
---|
| 85 | . . W ?50,$$GET1^DIQ(200,$P(DGNODE,U,2),.01)
|
---|
| 86 | . . W ?80,$$FMTE^XLFDT($P(DGNODE,U,5),"2D")
|
---|
| 87 | . . W ?90,$$GET1^DIQ(200,$P(DGNODE,U,4),.01)
|
---|
| 88 | . . W !?5,$P(DGNODE,U,9)
|
---|
| 89 | Q
|
---|
| 90 | ;
|
---|
| 91 | HDR(DGBEG,DGEND) ;
|
---|
| 92 | N LINE,TXT,SPACE
|
---|
| 93 | ;
|
---|
| 94 | I $E(IOST,1,2)="C-" W @IOF
|
---|
| 95 | S TXT="Cleared Fugitive Felon Status Report"
|
---|
| 96 | S SPACE=(IOM-$L(TXT))/2
|
---|
| 97 | W !?SPACE,TXT
|
---|
| 98 | ;
|
---|
| 99 | I DGBEG>0 D
|
---|
| 100 | . S TXT="Report Date Range: "_$$FMTE^XLFDT(DGBEG)_" to "_$$FMTE^XLFDT(DGEND)
|
---|
| 101 | . S SPACE=(IOM-$L(TXT))/2
|
---|
| 102 | . W !?SPACE,TXT
|
---|
| 103 | ;
|
---|
| 104 | S TXT="Print Date: "_$$FMTE^XLFDT($$NOW^XLFDT)
|
---|
| 105 | S SPACE=(IOM-$L(TXT))/2
|
---|
| 106 | W !?SPACE,TXT
|
---|
| 107 | ;
|
---|
| 108 | S PAGE=PAGE+1
|
---|
| 109 | S TXT="Page: "_PAGE
|
---|
| 110 | S SPACE=(IOM-$L(TXT))/2
|
---|
| 111 | W !?SPACE,TXT
|
---|
| 112 | ;
|
---|
| 113 | W !!,"Patient Name",?40,"Entered",?50,"Who Entered",?80,"Cleared",?90,"Who Cleared"
|
---|
| 114 | S $P(LINE,"=",IOM)="" W !,LINE
|
---|
| 115 | Q
|
---|