DGFFP03 ; ALB/SCK - FUGITIVE FELON PROGRAM VISIT REPORT ; 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 showing those patients for whom 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^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 CURRENT STATUS REPORT"
S ZTRTN="RPT^DGFFP03"
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
S PAGE=1
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 ; Retrieve entire list of patient to print
N DGDFN,DFN,VAROOT,DGINP
;
S DGDFN=0
F S DGDFN=$O(^DPT("AXFFP",1,DGDFN)) Q:'DGDFN D
. S DFN=DGDFN,VAROOT="DGINP"
. D INP^VADPT
. S ^TMP("DGFFP",$J,$S(+DGINP(1):"I",1:"O"),$$GET1^DIQ(2,DGDFN,.01),DGDFN)=""
. K DGINP
Q
;
GETLST(DGBEG,DGEND) ; Retrieve list of patients with the Fugitive Felon Flag set within specified date range
N DGDFN,DFN,VAROOT,DGINP,DGFFP
;
S DGEND=$$FMADD^XLFDT(DGEND,1)
S DGDFN=0
F S DGDFN=$O(^DPT("AXFFP",1,DGDFN)) Q:'DGDFN D
. S DGFFP=$P($G(^DPT(DGDFN,"FFP")),U,3)
. I DGFFP>DGBEG&(DGFFP<DGEND) D
. . S DFN=DGDFN,VAROOT="DGINP"
. . D INP^VADPT
. . S ^TMP("DGFFP",$J,$S(+DGINP(1):"I",1:"O"),$$GET1^DIQ(2,DGDFN,.01),DGDFN)=""
. . K DGINP
Q
;
PRINT(DGBEG,DGEND) ; Print report
;
D INPT(DGBEG,DGEND)
D OUTP(DGBEG,DGEND)
D SCHED(DGBEG,DGEND)
Q
;
INPT(DGBEG,DGEND) ;
N DGNAME,DFN,DGABRT,VA,DGAPT,TXT,DGSTAT
;
D HDR(DGBEG,DGEND)
D INPHDR
;
I '$D(^TMP("DGFFP",$J,"I")) W !!,"No Patients Found" Q
S DGNAME=""
F S DGNAME=$O(^TMP("DGFFP",$J,"I",DGNAME)) Q:DGNAME']"" D Q:$G(DGABRT)
. S DFN=0
. F S DFN=$O(^TMP("DGFFP",$J,"I",DGNAME,DFN)) Q:'DFN D Q:$G(DGABRT)
. . D PID^VADPT6
. . S TXT=$E(DGNAME,1,$L(DGNAME))_" ("_VA("BID")_")" W !,TXT
. . D PRNINP(DFN)
. . D PRNSCRP(DFN)
. . D PRNRCNT(DFN)
. . W !
. . I (($Y+5)>IOSL) D
. . . I $$PAUSE^DGFFP02 S DGABRT=1 Q
.. . D HDR(DGBEG,DGEND),INPHDR
Q
;
OUTP(DGBEG,DGEND) ;
N DGNAME,DFN,DGABRT,VA,DGAPT,TXT,DGSTAT
;
D HDR(DGBEG,DGEND)
D OUTHDR
;
I '$D(^TMP("DGFFP",$J,"O")) W !!,"No Patients Found" Q
S DGNAME=""
F S DGNAME=$O(^TMP("DGFFP",$J,"O",DGNAME)) Q:DGNAME']"" D Q:$G(DGABRT)
. S DFN=0
. F S DFN=$O(^TMP("DGFFP",$J,"O",DGNAME,DFN)) Q:'DFN D Q:$G(DGABRT)
. . D PID^VADPT6
. . S TXT=$E(DGNAME,1,$L(DGNAME))_" ("_VA("BID")_")" W !,TXT
. . D PRNSCRP(DFN)
. . D PRNRCNT(DFN)
. . D PRNAPT(DFN)
. . W !
. . I (($Y+5)>IOSL) D
. . . I $$PAUSE^DGFFP02 S DGABRT=1 Q
. . . D HDR(DGBEG,DGEND),INPHDR
Q
;
SCHED(DGBEG,DGEND) ;
N DGNAME,DFN,DGABRT,VA,DGAPT,TXT,DGSTAT,TMPARY
;
D HDR(DGBEG,DGEND)
D FUHDR
;
S DFN=0
F S DFN=$O(^DPT("AXFFP",1,DFN)) Q:'DFN D
. S ^TMP("DGFFP",$J,"F",$$GET1^DIQ(2,DFN,.01),DFN)=""
;
S DGNAME=""
F S DGNAME=$O(^TMP("DGFFP",$J,"F",DGNAME)) Q:DGNAME']"" D Q:$G(DGABRT)
. S DFN=0
. F S DFN=$O(^TMP("DGFFP",$J,"F",DGNAME,DFN)) Q:'DFN D Q:$G(DGABRT)
. . S TMPARY="^TMP(""DGFFPF"",$J)" K @TMPARY
. . D GETFUADM(DFN,TMPARY)
. . Q:'$D(@TMPARY)
. . D PID^VADPT6
. . S TXT=$E(DGNAME,1,$L(DGNAME))_" ("_VA("BID")_")" W !,TXT
. . D PRNSCRP(DFN)
. . D PRNRCNT(DFN)
. . D PRNFUT(TMPARY)
. . K @TMPARY
Q
;
PRNFUT(TMPARY) ;
N DGDT,DGWARD
;
S DGDT=0
F S DGDT=$O(@TMPARY@(DGDT)) Q:'DGDT D
. W !?40,$$FMTE^XLFDT(DGDT,"1P")
. S DGWARD=$P(@TMPARY@(DGDT),U,8)
. W ?80,$$GET1^DIQ(42,DGWARD,.01)
Q
;
PRNSCRP(DFN) ; Print Active Script Information
N DGSCRPT
;
S DGSCRPT=$$GET1^DIQ(55,DFN,50)
W ?110,$S(DGSCRPT>0:DGSCRPT,1:"None")
Q
;
PRNINP(DFN) ; Print Inpatient Information
N VAROOT,DGIN
;
S VAROOT="DGIN"
D IN5^VADPT
W ?40,$P(DGIN(2),U,2)
W ?55,$$FMTE^XLFDT($P(DGIN(3),U,1),"D")
W ?70,$P(DGIN(6),U,2)
W ?80,$P(DGIN(5),U,2)
Q
;
PRNRCNT(DFN) ; Print most recent activity
N DGLAST
;
S DGLAST=$$LASTACT^DGFFPLM(DFN)
I DGLAST]"" D
. W !?3,">> "_DGLAST
Q
;
PRNAPT(DFN) ; Print Future Appointment information
N LINE,DGRTN,DGCLN,DGDT,TEMP
;
S TEMP="^TMP(""VASD"",$J)"
K @TEMP
D GETAPT(DFN,TEMP)
S DGCLN=""
F S DGCLN=$O(@TEMP@(DGCLN)) Q:DGCLN']"" D Q:$G(RSLT)
. W !?40,DGCLN
. S DGDT=0
. F S DGDT=$O(@TEMP@(DGCLN,DGDT)) Q:'DGDT D Q:$G(RSLT)
. . W ?70,$$FMTE^XLFDT(DGDT,"1P"),!
K @TEMP
Q
;
GETAPT(DFN,TEMP) ; Sort Clinic appointments by clinic
N LINE,VAROOT,VASD,DGAPT
;
D SDA^VADPT
S DGAPT="^UTILITY(""VASD"",$J)"
S LINE=0
F S LINE=$O(@DGAPT@(LINE)) Q:'LINE D
. S @TEMP@($P(@DGAPT@(LINE,"E"),U,2),$P(@DGAPT@(LINE,"I"),U,1))=$P(@DGAPT@(LINE,"E"),U,3)
K @DGAPT
Q
;
GETFUADM(DFN,TMPARY) ; Get future scheduled admissions
N DGIEN,DGNODE
;
S DGIEN=0
F S DGIEN=$O(^DGS(41.1,"B",DFN,DGIEN)) Q:'DGIEN D
. S DGNODE=$G(^DGS(41.1,DGIEN,0))
. S @TMPARY@($P(DGNODE,U,2))=DGNODE
Q
;
HDR(DGBEG,DGEND) ;
N LINE,TXT,SPACE
;
I $E(IOST,1,2)="C-"!($G(PAGE)>1) W @IOF
S TXT="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 TXT="Page: "_PAGE
S SPACE=(IOM-$L(TXT))/2
W !?SPACE,TXT
S PAGE=PAGE+1
Q
;
INPHDR ;
N TXT,LINE,SPACE
;
S TXT="Inpatient Listing"
S SPACE=(IOM-$L(TXT))/2
W !?SPACE,TXT
;
W !!,"Patient Name",?40,"Movement",?55,"Date",?70,"Room/Bed",?80,"Ward",?110,"Active Scripts?"
S $P(LINE,"=",IOM)="" W !,LINE
Q
;
OUTHDR ;
N TXT,LINE,SPACE
;
S TXT="Outpatient Listing"
S SPACE=(IOM-$L(TXT))/2
W !?SPACE,TXT
;
W !!,"Patient Name",?40,"Clinic",?70,"Appt. D/T",?110,"Active Scripts?"
S $P(LINE,"=",IOM)="" W !,LINE
Q
;
FUHDR ;
N TXT,LINE,SPACE
;
S TXT="Future Scheduled Admissions"
S SPACE=(IOM-$L(TXT))/2
W !?SPACE,TXT
;
W !!,"Patient Name",?40,"Scheduled Admission",?80,"Ward",?110,"Active Scripts?"
S $P(LINE,"=",IOM)="" W !,LINE
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGFFP03 6680 printed Dec 13, 2024@02:43:30 Page 2
DGFFP03 ; ALB/SCK - FUGITIVE FELON PROGRAM VISIT REPORT ; 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 showing those patients for whom 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^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 CURRENT STATUS REPORT"
+4 SET ZTRTN="RPT^DGFFP03"
+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 SET PAGE=1
+5 KILL ^TMP("DGFFP",$JOB)
+6 ;
+7 IF +DGBEG>0
DO GETLST(DGBEG,DGEND)
+8 IF '$TEST
DO GETALL
+9 ;
+10 DO PRINT(DGBEG,DGEND)
+11 KILL ^TMP("DGFFP",$JOB)
+12 DO ^%ZISC
+13 QUIT
+14 ;
GETALL ; Retrieve entire list of patient to print
+1 NEW DGDFN,DFN,VAROOT,DGINP
+2 ;
+3 SET DGDFN=0
+4 FOR
SET DGDFN=$ORDER(^DPT("AXFFP",1,DGDFN))
if 'DGDFN
QUIT
Begin DoDot:1
+5 SET DFN=DGDFN
SET VAROOT="DGINP"
+6 DO INP^VADPT
+7 SET ^TMP("DGFFP",$JOB,$SELECT(+DGINP(1):"I",1:"O"),$$GET1^DIQ(2,DGDFN,.01),DGDFN)=""
+8 KILL DGINP
End DoDot:1
+9 QUIT
+10 ;
GETLST(DGBEG,DGEND) ; Retrieve list of patients with the Fugitive Felon Flag set within specified date range
+1 NEW DGDFN,DFN,VAROOT,DGINP,DGFFP
+2 ;
+3 SET DGEND=$$FMADD^XLFDT(DGEND,1)
+4 SET DGDFN=0
+5 FOR
SET DGDFN=$ORDER(^DPT("AXFFP",1,DGDFN))
if 'DGDFN
QUIT
Begin DoDot:1
+6 SET DGFFP=$PIECE($GET(^DPT(DGDFN,"FFP")),U,3)
+7 IF DGFFP>DGBEG&(DGFFP<DGEND)
Begin DoDot:2
+8 SET DFN=DGDFN
SET VAROOT="DGINP"
+9 DO INP^VADPT
+10 SET ^TMP("DGFFP",$JOB,$SELECT(+DGINP(1):"I",1:"O"),$$GET1^DIQ(2,DGDFN,.01),DGDFN)=""
+11 KILL DGINP
End DoDot:2
End DoDot:1
+12 QUIT
+13 ;
PRINT(DGBEG,DGEND) ; Print report
+1 ;
+2 DO INPT(DGBEG,DGEND)
+3 DO OUTP(DGBEG,DGEND)
+4 DO SCHED(DGBEG,DGEND)
+5 QUIT
+6 ;
INPT(DGBEG,DGEND) ;
+1 NEW DGNAME,DFN,DGABRT,VA,DGAPT,TXT,DGSTAT
+2 ;
+3 DO HDR(DGBEG,DGEND)
+4 DO INPHDR
+5 ;
+6 IF '$DATA(^TMP("DGFFP",$JOB,"I"))
WRITE !!,"No Patients Found"
QUIT
+7 SET DGNAME=""
+8 FOR
SET DGNAME=$ORDER(^TMP("DGFFP",$JOB,"I",DGNAME))
if DGNAME']""
QUIT
Begin DoDot:1
+9 SET DFN=0
+10 FOR
SET DFN=$ORDER(^TMP("DGFFP",$JOB,"I",DGNAME,DFN))
if 'DFN
QUIT
Begin DoDot:2
+11 DO PID^VADPT6
+12 SET TXT=$EXTRACT(DGNAME,1,$LENGTH(DGNAME))_" ("_VA("BID")_")"
WRITE !,TXT
+13 DO PRNINP(DFN)
+14 DO PRNSCRP(DFN)
+15 DO PRNRCNT(DFN)
+16 WRITE !
+17 IF (($Y+5)>IOSL)
Begin DoDot:3
+18 IF $$PAUSE^DGFFP02
SET DGABRT=1
QUIT
+19 DO HDR(DGBEG,DGEND)
DO INPHDR
End DoDot:3
End DoDot:2
if $GET(DGABRT)
QUIT
End DoDot:1
if $GET(DGABRT)
QUIT
+20 QUIT
+21 ;
OUTP(DGBEG,DGEND) ;
+1 NEW DGNAME,DFN,DGABRT,VA,DGAPT,TXT,DGSTAT
+2 ;
+3 DO HDR(DGBEG,DGEND)
+4 DO OUTHDR
+5 ;
+6 IF '$DATA(^TMP("DGFFP",$JOB,"O"))
WRITE !!,"No Patients Found"
QUIT
+7 SET DGNAME=""
+8 FOR
SET DGNAME=$ORDER(^TMP("DGFFP",$JOB,"O",DGNAME))
if DGNAME']""
QUIT
Begin DoDot:1
+9 SET DFN=0
+10 FOR
SET DFN=$ORDER(^TMP("DGFFP",$JOB,"O",DGNAME,DFN))
if 'DFN
QUIT
Begin DoDot:2
+11 DO PID^VADPT6
+12 SET TXT=$EXTRACT(DGNAME,1,$LENGTH(DGNAME))_" ("_VA("BID")_")"
WRITE !,TXT
+13 DO PRNSCRP(DFN)
+14 DO PRNRCNT(DFN)
+15 DO PRNAPT(DFN)
+16 WRITE !
+17 IF (($Y+5)>IOSL)
Begin DoDot:3
+18 IF $$PAUSE^DGFFP02
SET DGABRT=1
QUIT
+19 DO HDR(DGBEG,DGEND)
DO INPHDR
End DoDot:3
End DoDot:2
if $GET(DGABRT)
QUIT
End DoDot:1
if $GET(DGABRT)
QUIT
+20 QUIT
+21 ;
SCHED(DGBEG,DGEND) ;
+1 NEW DGNAME,DFN,DGABRT,VA,DGAPT,TXT,DGSTAT,TMPARY
+2 ;
+3 DO HDR(DGBEG,DGEND)
+4 DO FUHDR
+5 ;
+6 SET DFN=0
+7 FOR
SET DFN=$ORDER(^DPT("AXFFP",1,DFN))
if 'DFN
QUIT
Begin DoDot:1
+8 SET ^TMP("DGFFP",$JOB,"F",$$GET1^DIQ(2,DFN,.01),DFN)=""
End DoDot:1
+9 ;
+10 SET DGNAME=""
+11 FOR
SET DGNAME=$ORDER(^TMP("DGFFP",$JOB,"F",DGNAME))
if DGNAME']""
QUIT
Begin DoDot:1
+12 SET DFN=0
+13 FOR
SET DFN=$ORDER(^TMP("DGFFP",$JOB,"F",DGNAME,DFN))
if 'DFN
QUIT
Begin DoDot:2
+14 SET TMPARY="^TMP(""DGFFPF"",$J)"
KILL @TMPARY
+15 DO GETFUADM(DFN,TMPARY)
+16 if '$DATA(@TMPARY)
QUIT
+17 DO PID^VADPT6
+18 SET TXT=$EXTRACT(DGNAME,1,$LENGTH(DGNAME))_" ("_VA("BID")_")"
WRITE !,TXT
+19 DO PRNSCRP(DFN)
+20 DO PRNRCNT(DFN)
+21 DO PRNFUT(TMPARY)
+22 KILL @TMPARY
End DoDot:2
if $GET(DGABRT)
QUIT
End DoDot:1
if $GET(DGABRT)
QUIT
+23 QUIT
+24 ;
PRNFUT(TMPARY) ;
+1 NEW DGDT,DGWARD
+2 ;
+3 SET DGDT=0
+4 FOR
SET DGDT=$ORDER(@TMPARY@(DGDT))
if 'DGDT
QUIT
Begin DoDot:1
+5 WRITE !?40,$$FMTE^XLFDT(DGDT,"1P")
+6 SET DGWARD=$PIECE(@TMPARY@(DGDT),U,8)
+7 WRITE ?80,$$GET1^DIQ(42,DGWARD,.01)
End DoDot:1
+8 QUIT
+9 ;
PRNSCRP(DFN) ; Print Active Script Information
+1 NEW DGSCRPT
+2 ;
+3 SET DGSCRPT=$$GET1^DIQ(55,DFN,50)
+4 WRITE ?110,$SELECT(DGSCRPT>0:DGSCRPT,1:"None")
+5 QUIT
+6 ;
PRNINP(DFN) ; Print Inpatient Information
+1 NEW VAROOT,DGIN
+2 ;
+3 SET VAROOT="DGIN"
+4 DO IN5^VADPT
+5 WRITE ?40,$PIECE(DGIN(2),U,2)
+6 WRITE ?55,$$FMTE^XLFDT($PIECE(DGIN(3),U,1),"D")
+7 WRITE ?70,$PIECE(DGIN(6),U,2)
+8 WRITE ?80,$PIECE(DGIN(5),U,2)
+9 QUIT
+10 ;
PRNRCNT(DFN) ; Print most recent activity
+1 NEW DGLAST
+2 ;
+3 SET DGLAST=$$LASTACT^DGFFPLM(DFN)
+4 IF DGLAST]""
Begin DoDot:1
+5 WRITE !?3,">> "_DGLAST
End DoDot:1
+6 QUIT
+7 ;
PRNAPT(DFN) ; Print Future Appointment information
+1 NEW LINE,DGRTN,DGCLN,DGDT,TEMP
+2 ;
+3 SET TEMP="^TMP(""VASD"",$J)"
+4 KILL @TEMP
+5 DO GETAPT(DFN,TEMP)
+6 SET DGCLN=""
+7 FOR
SET DGCLN=$ORDER(@TEMP@(DGCLN))
if DGCLN']""
QUIT
Begin DoDot:1
+8 WRITE !?40,DGCLN
+9 SET DGDT=0
+10 FOR
SET DGDT=$ORDER(@TEMP@(DGCLN,DGDT))
if 'DGDT
QUIT
Begin DoDot:2
+11 WRITE ?70,$$FMTE^XLFDT(DGDT,"1P"),!
End DoDot:2
if $GET(RSLT)
QUIT
End DoDot:1
if $GET(RSLT)
QUIT
+12 KILL @TEMP
+13 QUIT
+14 ;
GETAPT(DFN,TEMP) ; Sort Clinic appointments by clinic
+1 NEW LINE,VAROOT,VASD,DGAPT
+2 ;
+3 DO SDA^VADPT
+4 SET DGAPT="^UTILITY(""VASD"",$J)"
+5 SET LINE=0
+6 FOR
SET LINE=$ORDER(@DGAPT@(LINE))
if 'LINE
QUIT
Begin DoDot:1
+7 SET @TEMP@($PIECE(@DGAPT@(LINE,"E"),U,2),$PIECE(@DGAPT@(LINE,"I"),U,1))=$PIECE(@DGAPT@(LINE,"E"),U,3)
End DoDot:1
+8 KILL @DGAPT
+9 QUIT
+10 ;
GETFUADM(DFN,TMPARY) ; Get future scheduled admissions
+1 NEW DGIEN,DGNODE
+2 ;
+3 SET DGIEN=0
+4 FOR
SET DGIEN=$ORDER(^DGS(41.1,"B",DFN,DGIEN))
if 'DGIEN
QUIT
Begin DoDot:1
+5 SET DGNODE=$GET(^DGS(41.1,DGIEN,0))
+6 SET @TMPARY@($PIECE(DGNODE,U,2))=DGNODE
End DoDot:1
+7 QUIT
+8 ;
HDR(DGBEG,DGEND) ;
+1 NEW LINE,TXT,SPACE
+2 ;
+3 IF $EXTRACT(IOST,1,2)="C-"!($GET(PAGE)>1)
WRITE @IOF
+4 SET TXT="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 TXT="Page: "_PAGE
+18 SET SPACE=(IOM-$LENGTH(TXT))/2
+19 WRITE !?SPACE,TXT
+20 SET PAGE=PAGE+1
+21 QUIT
+22 ;
INPHDR ;
+1 NEW TXT,LINE,SPACE
+2 ;
+3 SET TXT="Inpatient Listing"
+4 SET SPACE=(IOM-$LENGTH(TXT))/2
+5 WRITE !?SPACE,TXT
+6 ;
+7 WRITE !!,"Patient Name",?40,"Movement",?55,"Date",?70,"Room/Bed",?80,"Ward",?110,"Active Scripts?"
+8 SET $PIECE(LINE,"=",IOM)=""
WRITE !,LINE
+9 QUIT
+10 ;
OUTHDR ;
+1 NEW TXT,LINE,SPACE
+2 ;
+3 SET TXT="Outpatient Listing"
+4 SET SPACE=(IOM-$LENGTH(TXT))/2
+5 WRITE !?SPACE,TXT
+6 ;
+7 WRITE !!,"Patient Name",?40,"Clinic",?70,"Appt. D/T",?110,"Active Scripts?"
+8 SET $PIECE(LINE,"=",IOM)=""
WRITE !,LINE
+9 QUIT
+10 ;
FUHDR ;
+1 NEW TXT,LINE,SPACE
+2 ;
+3 SET TXT="Future Scheduled Admissions"
+4 SET SPACE=(IOM-$LENGTH(TXT))/2
+5 WRITE !?SPACE,TXT
+6 ;
+7 WRITE !!,"Patient Name",?40,"Scheduled Admission",?80,"Ward",?110,"Active Scripts?"
+8 SET $PIECE(LINE,"=",IOM)=""
WRITE !,LINE
+9 QUIT
