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