DGFFPLM1 ;ALB/SCK - FUGITIVE FELON PROGRAM LIST MANAGER - 2 ; 12/6/02
;;5.3;Registration;**485,1015**;Aug 13, 1993;Build 21
;
SEL(DFN) ;
N DIC
;
W ! S DIC="^DPT(",DIC(0)="AEQMZ"
D ^DIC
S DFN=+Y
Q
;
EN(DFN,DGARY,DGSTART,DGCNT) ;
N VAROOT,DGADD,VAPA,DGTMP,DGLINE,TXT,X,Y,DGDT,DGCLN,TEMP,DGFFP,TMPARY,DGWARD
;
S VAPA("P")=""
S VAROOT="DGADD" D ADD^VADPT
K VAPA
S VAROOT="DGTMP" D ADD^VADPT
I '+DGTMP(9)>0 K DGTMP
;
S DGLINE=DGSTART,DGCNT=0
;
; FF Program Information
S DGFFP=$G(^DPT(DFN,"FFP"))
S X=$$SETSTR^VALM1("Date Set:","",5,15)
S X=$$SETSTR^VALM1($$FMTE^XLFDT($P(DGFFP,U,3),"D"),X,20,20)
S X=$$SETSTR^VALM1("Set By:",X,40,12)
S X=$$SETSTR^VALM1($$GET1^DIQ(200,$P(DGFFP,U,2),.01),X,53,30)
D SET(DGARY,DGLINE,X,.DGCNT) S DGLINE=DGLINE+1
;
S X=$$SETSTR^VALM1("Date Cleared:","",5,15)
S X=$$SETSTR^VALM1($$FMTE^XLFDT($P(DGFFP,U,5),"D"),X,20,20)
S X=$$SETSTR^VALM1("Cleared By:",X,40,12)
S X=$$SETSTR^VALM1($$GET1^DIQ(200,$P(DGFFP,U,4),.01),X,53,30)
D SET(DGARY,DGLINE,X,.DGCNT) S DGLINE=DGLINE+1
;
S X=$$SETSTR^VALM1("Closing Remark:","",5,18)
S X=$$SETSTR^VALM1($P(DGFFP,U,9),X,23,110)
D SET(DGARY,DGLINE,X,.DGCNT) S DGLINE=DGLINE+1
;
D SET(DGARY,DGLINE,"",.DGCNT) S DGLINE=DGLINE+1
;
; Address Information
S X=$$SETSTR^VALM1("Permanent Address:","",5,30)
S X=$$SETSTR^VALM1("Temporary Address:",X,35,30)
D SET(DGARY,DGLINE,X,.DGCNT) S DGLINE=DGLINE+1
;
S X=$$SETSTR^VALM1("==================","",5,30)
S X=$$SETSTR^VALM1("==================",X,35,30)
D SET(DGARY,DGLINE,X,.DGCNT) S DGLINE=DGLINE+1
;
S X=$$SETSTR^VALM1(DGADD(1),"",5,30)
S X=$$SETSTR^VALM1($G(DGTMP(1)),X,35,30)
D SET(DGARY,DGLINE,X,.DGCNT) S DGLINE=DGLINE+1
;
S X=$$SETSTR^VALM1(DGADD(2),"",5,30)
S X=$$SETSTR^VALM1($G(DGTMP(2)),X,35,30)
D SET(DGARY,DGLINE,X,.DGCNT) S DGLINE=DGLINE+1
;
S X=$$SETSTR^VALM1(DGADD(4),"",5,30)
S X=$$SETSTR^VALM1($G(DGTMP(4)),X,35,30)
D SET(DGARY,DGLINE,X,.DGCNT) S DGLINE=DGLINE+1
;
S X=$$SETSTR^VALM1($P(DGADD(5),U,2),"",5,30)
S X=$$SETSTR^VALM1($P($G(DGTMP(5)),U,2),X,35,30)
D SET(DGARY,DGLINE,X,.DGCNT) S DGLINE=DGLINE+1
;
S X=$$SETSTR^VALM1($P(DGADD(11),U,2),"",5,30)
S X=$$SETSTR^VALM1($P($G(DGTMP(11)),U,2),X,35,30)
D SET(DGARY,DGLINE,X,.DGCNT) S DGLINE=DGLINE+1
;
I +$G(DGTMP(9))>0 D
. S X=$$SETSTR^VALM1("Effective Date: ","",35,20)
. S X=$$SETSTR^VALM1($P($G(DGTMP(9)),U,2),X,55,20)
. D SET(DGARY,DGLINE,X,.DGCNT) S DGLINE=DGLINE+1
. S X=$$SETSTR^VALM1("End Date: ",X,35,20)
. S X=$$SETSTR^VALM1($P($G(DGTMP(10)),U,2),X,55,20)
. D SET(DGARY,DGLINE,X,.DGCNT) S DGLINE=DGLINE+1
;
N XCNT
F XCNT=DGLINE:1:VALM("LINES") D
. D SET(DGARY,DGLINE,"",.DGCNT) S DGLINE=DGLINE+1
;
; Inpatient Information
N DGIN
;
S VAROOT="DGIN"
D IN5^VADPT
I DGIN(1)>0 D
. S X=$$SETSTR^VALM1("Last Inpatient Movement:","",5,30)
. D SET(DGARY,DGLINE,X,.DGCNT) S DGLINE=DGLINE+1
. S X=$$SETSTR^VALM1("========================",X,5,30)
. D SET(DGARY,DGLINE,X,.DGCNT) S DGLINE=DGLINE+1
. ;
. S X=$$SETSTR^VALM1($P(DGIN(2),U,2),X,5,20)
. S X=$$SETSTR^VALM1($$FMTE^XLFDT($P(DGIN(3),U,1),"D"),X,21,14)
. D SET(DGARY,DGLINE,X,.DGCNT) S DGLINE=DGLINE+1
. ;
. S X="",X=$$SETSTR^VALM1("Room/Bed:",X,8,12)
. S X=$$SETSTR^VALM1($P(DGIN(6),U,2),X,20,20)
. S X=$$SETSTR^VALM1("Ward:",X,40,5)
. S X=$$SETSTR^VALM1($P(DGIN(5),U,2),X,48,20)
. D SET(DGARY,DGLINE,X,.DGCNT) S DGLINE=DGLINE+1
. D SET(DGARY,DGLINE,"",.DGCNT) S DGLINE=DGLINE+1
;
; Future Scheduled Admission
S X=$$SETSTR^VALM1("Future Scheduled Admissions:","",5,30)
D SET(DGARY,DGLINE,X,.DGCNT) S DGLINE=DGLINE+1
S X=$$SETSTR^VALM1("============================",X,5,30)
D SET(DGARY,DGLINE,X,.DGCNT) S DGLINE=DGLINE+1
;
S TMPARY="^TMP(""DGFFPFU"",$J)"
K @TMPARY
D GETFUADM^DGFFP03(DFN,TMPARY)
;
S DGDT=0
F S DGDT=$O(@TMPARY@(DGDT)) Q:'DGDT D
. S X=$$SETSTR^VALM1("Scheduled:","",5,10)
. S X=$$SETSTR^VALM1($$FMTE^XLFDT(DGDT,"1P"),X,17,30)
. S DGWARD=$P(@TMPARY@(DGDT),U,8)
. S X=$$SETSTR^VALM1("Ward:",X,47,5)
. S X=$$SETSTR^VALM1($$GET1^DIQ(42,DGWARD,.01),X,53,80)
. D SET(DGARY,DGLINE,X,.DGCNT) S DGLINE=DGLINE+1
;
D SET(DGARY,DGLINE,"",.DGCNT) S DGLINE=DGLINE+1
D SET(DGARY,DGLINE,"",.DGCNT) S DGLINE=DGLINE+1
K @TMPARY
;
; Outpatient Information
N TEMP
;
S TEMP="^TMP(""DGFFPOP"",$J)"
K @TEMP
D GETAPT^DGFFP03(DFN,TEMP)
;
S X=""
S X=$$SETSTR^VALM1("Future Appointments:",X,5,30)
D SET(DGARY,DGLINE,X,.DGCNT) S DGLINE=DGLINE+1
S X=$$SETSTR^VALM1("====================",X,5,30)
D SET(DGARY,DGLINE,X,.DGCNT) S DGLINE=DGLINE+1
;
S DGCLN=""
F S DGCLN=$O(@TEMP@(DGCLN)) Q:DGCLN']"" D
. S X=$$SETSTR^VALM1(DGCLN,"",5,30)
. D SET(DGARY,DGLINE,X,.DGCNT) S DGLINE=DGLINE+1
. S DGDT=0
. F S DGDT=$O(@TEMP@(DGCLN,DGDT)) Q:'DGDT D
. . S X=$$SETSTR^VALM1($$FMTE^XLFDT(DGDT,"1P"),"",10,40)
. . D SET(DGARY,DGLINE,X,.DGCNT) S DGLINE=DGLINE+1
K @TEMP
D SET(DGARY,DGLINE,"",.DGCNT) S DGLINE=DGLINE+1
D SET(DGARY,DGLINE,"",.DGCNT) S DGLINE=DGLINE+1
Q
;
SET(DGARY,DGLINE,DGTEXT,DGCNT) ;
N X
;
S:DGLINE>DGCNT DGCNT=DGLINE
S X=$S($D(^TMP(DGARY,$J,DGLINE,0)):^(0),1:"")
S ^TMP(DGARY,$J,DGLINE,0)=DGTEXT
S ^TMP(DGARY_"IDX",$J,DGLINE,DGLINE)=DGLINE
S DGLINE=DGLINE+1
Q
DGFFPLM1 ;ALB/SCK - FUGITIVE FELON PROGRAM LIST MANAGER - 2 ; 12/6/02
+1 ;;5.3;Registration;**485,1015**;Aug 13, 1993;Build 21
+2 ;
SEL(DFN) ;
+1 NEW DIC
+2 ;
+3 WRITE !
SET DIC="^DPT("
SET DIC(0)="AEQMZ"
+4 DO ^DIC
+5 SET DFN=+Y
+6 QUIT
+7 ;
EN(DFN,DGARY,DGSTART,DGCNT) ;
+1 NEW VAROOT,DGADD,VAPA,DGTMP,DGLINE,TXT,X,Y,DGDT,DGCLN,TEMP,DGFFP,TMPARY,DGWARD
+2 ;
+3 SET VAPA("P")=""
+4 SET VAROOT="DGADD"
DO ADD^VADPT
+5 KILL VAPA
+6 SET VAROOT="DGTMP"
DO ADD^VADPT
+7 IF '+DGTMP(9)>0
KILL DGTMP
+8 ;
+9 SET DGLINE=DGSTART
SET DGCNT=0
+10 ;
+11 ; FF Program Information
+12 SET DGFFP=$GET(^DPT(DFN,"FFP"))
+13 SET X=$$SETSTR^VALM1("Date Set:","",5,15)
+14 SET X=$$SETSTR^VALM1($$FMTE^XLFDT($PIECE(DGFFP,U,3),"D"),X,20,20)
+15 SET X=$$SETSTR^VALM1("Set By:",X,40,12)
+16 SET X=$$SETSTR^VALM1($$GET1^DIQ(200,$PIECE(DGFFP,U,2),.01),X,53,30)
+17 DO SET(DGARY,DGLINE,X,.DGCNT)
SET DGLINE=DGLINE+1
+18 ;
+19 SET X=$$SETSTR^VALM1("Date Cleared:","",5,15)
+20 SET X=$$SETSTR^VALM1($$FMTE^XLFDT($PIECE(DGFFP,U,5),"D"),X,20,20)
+21 SET X=$$SETSTR^VALM1("Cleared By:",X,40,12)
+22 SET X=$$SETSTR^VALM1($$GET1^DIQ(200,$PIECE(DGFFP,U,4),.01),X,53,30)
+23 DO SET(DGARY,DGLINE,X,.DGCNT)
SET DGLINE=DGLINE+1
+24 ;
+25 SET X=$$SETSTR^VALM1("Closing Remark:","",5,18)
+26 SET X=$$SETSTR^VALM1($PIECE(DGFFP,U,9),X,23,110)
+27 DO SET(DGARY,DGLINE,X,.DGCNT)
SET DGLINE=DGLINE+1
+28 ;
+29 DO SET(DGARY,DGLINE,"",.DGCNT)
SET DGLINE=DGLINE+1
+30 ;
+31 ; Address Information
+32 SET X=$$SETSTR^VALM1("Permanent Address:","",5,30)
+33 SET X=$$SETSTR^VALM1("Temporary Address:",X,35,30)
+34 DO SET(DGARY,DGLINE,X,.DGCNT)
SET DGLINE=DGLINE+1
+35 ;
+36 SET X=$$SETSTR^VALM1("==================","",5,30)
+37 SET X=$$SETSTR^VALM1("==================",X,35,30)
+38 DO SET(DGARY,DGLINE,X,.DGCNT)
SET DGLINE=DGLINE+1
+39 ;
+40 SET X=$$SETSTR^VALM1(DGADD(1),"",5,30)
+41 SET X=$$SETSTR^VALM1($GET(DGTMP(1)),X,35,30)
+42 DO SET(DGARY,DGLINE,X,.DGCNT)
SET DGLINE=DGLINE+1
+43 ;
+44 SET X=$$SETSTR^VALM1(DGADD(2),"",5,30)
+45 SET X=$$SETSTR^VALM1($GET(DGTMP(2)),X,35,30)
+46 DO SET(DGARY,DGLINE,X,.DGCNT)
SET DGLINE=DGLINE+1
+47 ;
+48 SET X=$$SETSTR^VALM1(DGADD(4),"",5,30)
+49 SET X=$$SETSTR^VALM1($GET(DGTMP(4)),X,35,30)
+50 DO SET(DGARY,DGLINE,X,.DGCNT)
SET DGLINE=DGLINE+1
+51 ;
+52 SET X=$$SETSTR^VALM1($PIECE(DGADD(5),U,2),"",5,30)
+53 SET X=$$SETSTR^VALM1($PIECE($GET(DGTMP(5)),U,2),X,35,30)
+54 DO SET(DGARY,DGLINE,X,.DGCNT)
SET DGLINE=DGLINE+1
+55 ;
+56 SET X=$$SETSTR^VALM1($PIECE(DGADD(11),U,2),"",5,30)
+57 SET X=$$SETSTR^VALM1($PIECE($GET(DGTMP(11)),U,2),X,35,30)
+58 DO SET(DGARY,DGLINE,X,.DGCNT)
SET DGLINE=DGLINE+1
+59 ;
+60 IF +$GET(DGTMP(9))>0
Begin DoDot:1
+61 SET X=$$SETSTR^VALM1("Effective Date: ","",35,20)
+62 SET X=$$SETSTR^VALM1($PIECE($GET(DGTMP(9)),U,2),X,55,20)
+63 DO SET(DGARY,DGLINE,X,.DGCNT)
SET DGLINE=DGLINE+1
+64 SET X=$$SETSTR^VALM1("End Date: ",X,35,20)
+65 SET X=$$SETSTR^VALM1($PIECE($GET(DGTMP(10)),U,2),X,55,20)
+66 DO SET(DGARY,DGLINE,X,.DGCNT)
SET DGLINE=DGLINE+1
End DoDot:1
+67 ;
+68 NEW XCNT
+69 FOR XCNT=DGLINE:1:VALM("LINES")
Begin DoDot:1
+70 DO SET(DGARY,DGLINE,"",.DGCNT)
SET DGLINE=DGLINE+1
End DoDot:1
+71 ;
+72 ; Inpatient Information
+73 NEW DGIN
+74 ;
+75 SET VAROOT="DGIN"
+76 DO IN5^VADPT
+77 IF DGIN(1)>0
Begin DoDot:1
+78 SET X=$$SETSTR^VALM1("Last Inpatient Movement:","",5,30)
+79 DO SET(DGARY,DGLINE,X,.DGCNT)
SET DGLINE=DGLINE+1
+80 SET X=$$SETSTR^VALM1("========================",X,5,30)
+81 DO SET(DGARY,DGLINE,X,.DGCNT)
SET DGLINE=DGLINE+1
+82 ;
+83 SET X=$$SETSTR^VALM1($PIECE(DGIN(2),U,2),X,5,20)
+84 SET X=$$SETSTR^VALM1($$FMTE^XLFDT($PIECE(DGIN(3),U,1),"D"),X,21,14)
+85 DO SET(DGARY,DGLINE,X,.DGCNT)
SET DGLINE=DGLINE+1
+86 ;
+87 SET X=""
SET X=$$SETSTR^VALM1("Room/Bed:",X,8,12)
+88 SET X=$$SETSTR^VALM1($PIECE(DGIN(6),U,2),X,20,20)
+89 SET X=$$SETSTR^VALM1("Ward:",X,40,5)
+90 SET X=$$SETSTR^VALM1($PIECE(DGIN(5),U,2),X,48,20)
+91 DO SET(DGARY,DGLINE,X,.DGCNT)
SET DGLINE=DGLINE+1
+92 DO SET(DGARY,DGLINE,"",.DGCNT)
SET DGLINE=DGLINE+1
End DoDot:1
+93 ;
+94 ; Future Scheduled Admission
+95 SET X=$$SETSTR^VALM1("Future Scheduled Admissions:","",5,30)
+96 DO SET(DGARY,DGLINE,X,.DGCNT)
SET DGLINE=DGLINE+1
+97 SET X=$$SETSTR^VALM1("============================",X,5,30)
+98 DO SET(DGARY,DGLINE,X,.DGCNT)
SET DGLINE=DGLINE+1
+99 ;
+100 SET TMPARY="^TMP(""DGFFPFU"",$J)"
+101 KILL @TMPARY
+102 DO GETFUADM^DGFFP03(DFN,TMPARY)
+103 ;
+104 SET DGDT=0
+105 FOR
SET DGDT=$ORDER(@TMPARY@(DGDT))
IF 'DGDT
QUIT
Begin DoDot:1
+106 SET X=$$SETSTR^VALM1("Scheduled:","",5,10)
+107 SET X=$$SETSTR^VALM1($$FMTE^XLFDT(DGDT,"1P"),X,17,30)
+108 SET DGWARD=$PIECE(@TMPARY@(DGDT),U,8)
+109 SET X=$$SETSTR^VALM1("Ward:",X,47,5)
+110 SET X=$$SETSTR^VALM1($$GET1^DIQ(42,DGWARD,.01),X,53,80)
+111 DO SET(DGARY,DGLINE,X,.DGCNT)
SET DGLINE=DGLINE+1
End DoDot:1
+112 ;
+113 DO SET(DGARY,DGLINE,"",.DGCNT)
SET DGLINE=DGLINE+1
+114 DO SET(DGARY,DGLINE,"",.DGCNT)
SET DGLINE=DGLINE+1
+115 KILL @TMPARY
+116 ;
+117 ; Outpatient Information
+118 NEW TEMP
+119 ;
+120 SET TEMP="^TMP(""DGFFPOP"",$J)"
+121 KILL @TEMP
+122 DO GETAPT^DGFFP03(DFN,TEMP)
+123 ;
+124 SET X=""
+125 SET X=$$SETSTR^VALM1("Future Appointments:",X,5,30)
+126 DO SET(DGARY,DGLINE,X,.DGCNT)
SET DGLINE=DGLINE+1
+127 SET X=$$SETSTR^VALM1("====================",X,5,30)
+128 DO SET(DGARY,DGLINE,X,.DGCNT)
SET DGLINE=DGLINE+1
+129 ;
+130 SET DGCLN=""
+131 FOR
SET DGCLN=$ORDER(@TEMP@(DGCLN))
IF DGCLN']""
QUIT
Begin DoDot:1
+132 SET X=$$SETSTR^VALM1(DGCLN,"",5,30)
+133 DO SET(DGARY,DGLINE,X,.DGCNT)
SET DGLINE=DGLINE+1
+134 SET DGDT=0
+135 FOR
SET DGDT=$ORDER(@TEMP@(DGCLN,DGDT))
IF 'DGDT
QUIT
Begin DoDot:2
+136 SET X=$$SETSTR^VALM1($$FMTE^XLFDT(DGDT,"1P"),"",10,40)
+137 DO SET(DGARY,DGLINE,X,.DGCNT)
SET DGLINE=DGLINE+1
End DoDot:2
End DoDot:1
+138 KILL @TEMP
+139 DO SET(DGARY,DGLINE,"",.DGCNT)
SET DGLINE=DGLINE+1
+140 DO SET(DGARY,DGLINE,"",.DGCNT)
SET DGLINE=DGLINE+1
+141 QUIT
+142 ;
SET(DGARY,DGLINE,DGTEXT,DGCNT) ;
+1 NEW X
+2 ;
+3 IF DGLINE>DGCNT
SET DGCNT=DGLINE
+4 SET X=$SELECT($DATA(^TMP(DGARY,$JOB,DGLINE,0)):^(0),1:"")
+5 SET ^TMP(DGARY,$JOB,DGLINE,0)=DGTEXT
+6 SET ^TMP(DGARY_"IDX",$JOB,DGLINE,DGLINE)=DGLINE
+7 SET DGLINE=DGLINE+1
+8 QUIT
