DGFFP02 ; ALB/SCK - FUGITIVE FELON PROGRAM REPORTS ; 11/14/2002
;;5.3;Registration;**485**;Aug 13, 1993
;
QUE ;
N ZTSAVE,DGTMP,DIR,Y,DGEND,DGBEG,DIRUT,ZTRTN,ZTDESC,ZTDTH,ZTIO,%ZIS
;
S DIR(0)="YAO",DIR("B")="YES",DIR("A")="Print report by date range? "
S DIR("?",1)="Enter 'YES' to print the report for showing those patients for who the"
S DIR("?",2)="flag was set 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(.DGBEG,.DGEND) Q:'DGBEG
;
S %ZIS="Q" D ^%ZIS G EXIT:POP
I $D(IO("Q")) D START Q
D ADMIN,^%ZISC Q
;
START ;
S ZTDTH=$$NOW^XLFDT
S ZTSAVE("DGBEG")="",ZTSAVE("DGEND")=""
S ZTDESC="DGFFP FF FLAG ALPHA REPORT"
S ZTRTN="ADMIN^DGFFP02"
D ^%ZTLOAD
I $D(ZTSK)[0 W !!?5,"Report canceled"
E W !!?5,"Report Queued"
EXIT D HOME^%ZIS
Q
;
GETDT(DGBEG,DGEND) ; Retrieve Begin and End date values entered by the user
N DIR,DIRUT,Y
;
S (DGBEG,DGEND)=0
S DIR(0)="DAO^::EX"
S DIR("?")="^D HELP^%DTC"
S DIR("A")="Enter beginning date for report: "
D ^DIR
Q:$D(DIRUT)
S DGBEG=+Y
;
S DIR("A")="Enter end date for report: "
D ^DIR
I $D(DIRUT) S DGBEG=0 Q
S DGEND=+Y
Q
;
ADMIN ;
N PAGE
;
U IO
S PAGE=1
K ^TMP("DGFFP",$J)
;
I 'DGBEG D BLDALL
E D BLD(DGBEG,DGEND)
;
D PRINT(DGBEG,DGEND)
K ^TMP("DGFFP",$J)
D ^%ZISC
Q
;
BLD(DGBEG,DGEND) ; Build report for specified date range
N DGIEN,DGFFP
;
S DGEND=$$FMADD^XLFDT(DGEND,1)
S DGIEN=0
F S DGIEN=$O(^DPT("AXFFP",1,DGIEN)) Q:'DGIEN D
. S DGFFP=$G(^DPT(DGIEN,"FFP"))
. I $P($G(^DPT(DGIEN,"FFP")),U,3)>DGBEG&($P($G(^("FFP")),U,3)<DGEND) D
. . S ^TMP("DGFFP",$J,$$GET1^DIQ(2,DGIEN,.01),DGIEN)=DGFFP
Q
;
BLDALL ; Build report for entire date range
N DGIEN,DGFFP
;
S DGIEN=0
F S DGIEN=$O(^DPT("AXFFP",1,DGIEN)) Q:'DGIEN D
. S DGFFP=$G(^DPT(DGIEN,"FFP"))
. S ^TMP("DGFFP",$J,$$GET1^DIQ(2,DGIEN,.01),DGIEN)=DGFFP
Q
;
PRINT(DGBEG,DGEND) ;
N DGNAME,DGUSER,VA,DFN,TXT,DGABRT
;
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
. . W ?40,$$FMTE^XLFDT($P(^TMP("DGFFP",$J,DGNAME,DFN),U,3),"2D")
. . S DGUSER=$G(^TMP("DGFFP",$J,DGNAME,DFN))
. . I DGUSER>0 W ?50,$$GET1^DIQ(200,$P(DGUSER,U,2),.01)
. . I (($Y+5)>IOSL) D
. . . I $$PAUSE S DGABRT=1 Q
. . . D HDR(DGBEG,DGEND)
I $$PAUSE
;
Q
;
PAUSE() ; Screen pause for Terminal displays
N DIR,RSLT
;
I $E(IOST,1,2)="C-" D
. S DIR(0)="E"
. D ^DIR K DIR
. I 'Y S RSLT=1
Q $G(RSLT)
;
HDR(DGBEG,DGEND) ;
N LINE,TXT,SPACE
;
I $E(IOST,1,2)="C-" W @IOF
S TXT="Fugitive Felon Alpha List"
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 TXT="Page: "_PAGE
S SPACE=(IOM-$L(TXT))/2
W !?SPACE,TXT
S PAGE=PAGE+1
;
W !!,"Patient Name",?40,"Entered",?50,"Who Entered"
S $P(LINE,"=",IOM)="" W !,LINE
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGFFP02 3338 printed Dec 13, 2024@02:43:29 Page 2
DGFFP02 ; ALB/SCK - FUGITIVE FELON PROGRAM REPORTS ; 11/14/2002
+1 ;;5.3;Registration;**485**;Aug 13, 1993
+2 ;
QUE ;
+1 NEW ZTSAVE,DGTMP,DIR,Y,DGEND,DGBEG,DIRUT,ZTRTN,ZTDESC,ZTDTH,ZTIO,%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 for showing those patients for who the"
+5 SET DIR("?",2)="flag was set 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(.DGBEG,.DGEND)
if 'DGBEG
QUIT
+11 ;
+12 SET %ZIS="Q"
DO ^%ZIS
if POP
GOTO EXIT
+13 IF $DATA(IO("Q"))
DO START
QUIT
+14 DO ADMIN
DO ^%ZISC
QUIT
+15 ;
START ;
+1 SET ZTDTH=$$NOW^XLFDT
+2 SET ZTSAVE("DGBEG")=""
SET ZTSAVE("DGEND")=""
+3 SET ZTDESC="DGFFP FF FLAG ALPHA REPORT"
+4 SET ZTRTN="ADMIN^DGFFP02"
+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 ;
GETDT(DGBEG,DGEND) ; Retrieve Begin and End date values entered by the user
+1 NEW DIR,DIRUT,Y
+2 ;
+3 SET (DGBEG,DGEND)=0
+4 SET DIR(0)="DAO^::EX"
+5 SET DIR("?")="^D HELP^%DTC"
+6 SET DIR("A")="Enter beginning date for report: "
+7 DO ^DIR
+8 if $DATA(DIRUT)
QUIT
+9 SET DGBEG=+Y
+10 ;
+11 SET DIR("A")="Enter end date for report: "
+12 DO ^DIR
+13 IF $DATA(DIRUT)
SET DGBEG=0
QUIT
+14 SET DGEND=+Y
+15 QUIT
+16 ;
ADMIN ;
+1 NEW PAGE
+2 ;
+3 USE IO
+4 SET PAGE=1
+5 KILL ^TMP("DGFFP",$JOB)
+6 ;
+7 IF 'DGBEG
DO BLDALL
+8 IF '$TEST
DO BLD(DGBEG,DGEND)
+9 ;
+10 DO PRINT(DGBEG,DGEND)
+11 KILL ^TMP("DGFFP",$JOB)
+12 DO ^%ZISC
+13 QUIT
+14 ;
BLD(DGBEG,DGEND) ; Build report for specified date range
+1 NEW DGIEN,DGFFP
+2 ;
+3 SET DGEND=$$FMADD^XLFDT(DGEND,1)
+4 SET DGIEN=0
+5 FOR
SET DGIEN=$ORDER(^DPT("AXFFP",1,DGIEN))
if 'DGIEN
QUIT
Begin DoDot:1
+6 SET DGFFP=$GET(^DPT(DGIEN,"FFP"))
+7 IF $PIECE($GET(^DPT(DGIEN,"FFP")),U,3)>DGBEG&($PIECE($GET(^("FFP")),U,3)<DGEND)
Begin DoDot:2
+8 SET ^TMP("DGFFP",$JOB,$$GET1^DIQ(2,DGIEN,.01),DGIEN)=DGFFP
End DoDot:2
End DoDot:1
+9 QUIT
+10 ;
BLDALL ; Build report for entire date range
+1 NEW DGIEN,DGFFP
+2 ;
+3 SET DGIEN=0
+4 FOR
SET DGIEN=$ORDER(^DPT("AXFFP",1,DGIEN))
if 'DGIEN
QUIT
Begin DoDot:1
+5 SET DGFFP=$GET(^DPT(DGIEN,"FFP"))
+6 SET ^TMP("DGFFP",$JOB,$$GET1^DIQ(2,DGIEN,.01),DGIEN)=DGFFP
End DoDot:1
+7 QUIT
+8 ;
PRINT(DGBEG,DGEND) ;
+1 NEW DGNAME,DGUSER,VA,DFN,TXT,DGABRT
+2 ;
+3 DO HDR(DGBEG,DGEND)
+4 SET DGNAME=""
+5 FOR
SET DGNAME=$ORDER(^TMP("DGFFP",$JOB,DGNAME))
if DGNAME']""
QUIT
Begin DoDot:1
+6 SET DFN=0
+7 FOR
SET DFN=$ORDER(^TMP("DGFFP",$JOB,DGNAME,DFN))
if 'DFN
QUIT
Begin DoDot:2
+8 DO PID^VADPT6
+9 SET TXT=$EXTRACT(DGNAME,1,$LENGTH(DGNAME))_" "_"("_VA("BID")_")"
+10 WRITE !,TXT
+11 WRITE ?40,$$FMTE^XLFDT($PIECE(^TMP("DGFFP",$JOB,DGNAME,DFN),U,3),"2D")
+12 SET DGUSER=$GET(^TMP("DGFFP",$JOB,DGNAME,DFN))
+13 IF DGUSER>0
WRITE ?50,$$GET1^DIQ(200,$PIECE(DGUSER,U,2),.01)
+14 IF (($Y+5)>IOSL)
Begin DoDot:3
+15 IF $$PAUSE
SET DGABRT=1
QUIT
+16 DO HDR(DGBEG,DGEND)
End DoDot:3
End DoDot:2
if $GET(DGABRT)
QUIT
End DoDot:1
if $GET(DGABRT)
QUIT
+17 IF $$PAUSE
+18 ;
+19 QUIT
+20 ;
PAUSE() ; Screen pause for Terminal displays
+1 NEW DIR,RSLT
+2 ;
+3 IF $EXTRACT(IOST,1,2)="C-"
Begin DoDot:1
+4 SET DIR(0)="E"
+5 DO ^DIR
KILL DIR
+6 IF 'Y
SET RSLT=1
End DoDot:1
+7 QUIT $GET(RSLT)
+8 ;
HDR(DGBEG,DGEND) ;
+1 NEW LINE,TXT,SPACE
+2 ;
+3 IF $EXTRACT(IOST,1,2)="C-"
WRITE @IOF
+4 SET TXT="Fugitive Felon Alpha List"
+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 TXT="Page: "_PAGE
+18 SET SPACE=(IOM-$LENGTH(TXT))/2
+19 WRITE !?SPACE,TXT
+20 SET PAGE=PAGE+1
+21 ;
+22 WRITE !!,"Patient Name",?40,"Entered",?50,"Who Entered"
+23 SET $PIECE(LINE,"=",IOM)=""
WRITE !,LINE
+24 QUIT
