- 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 Feb 19, 2025@00:09:32 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