DGFFPLM1 ;ALB/SCK,ARF - FUGITIVE FELON PROGRAM LIST MANAGER - 2 ; 12/6/02
;;5.3;Registration;**485,1056**;Aug 13, 1993;Build 18
;
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
; DG*5.3*1056 - replaced Permanent with Mailing on the following label
S X=$$SETSTR^VALM1("Mailing 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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGFFPLM1 5379 printed Oct 16, 2024@18:44:11 Page 2
DGFFPLM1 ;ALB/SCK,ARF - FUGITIVE FELON PROGRAM LIST MANAGER - 2 ; 12/6/02
+1 ;;5.3;Registration;**485,1056**;Aug 13, 1993;Build 18
+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 ; DG*5.3*1056 - replaced Permanent with Mailing on the following label
+33 SET X=$$SETSTR^VALM1("Mailing Address:","",5,30)
+34 SET X=$$SETSTR^VALM1("Temporary Address:",X,35,30)
+35 DO SET(DGARY,DGLINE,X,.DGCNT)
SET DGLINE=DGLINE+1
+36 ;
+37 SET X=$$SETSTR^VALM1("==================","",5,30)
+38 SET X=$$SETSTR^VALM1("==================",X,35,30)
+39 DO SET(DGARY,DGLINE,X,.DGCNT)
SET DGLINE=DGLINE+1
+40 ;
+41 SET X=$$SETSTR^VALM1(DGADD(1),"",5,30)
+42 SET X=$$SETSTR^VALM1($GET(DGTMP(1)),X,35,30)
+43 DO SET(DGARY,DGLINE,X,.DGCNT)
SET DGLINE=DGLINE+1
+44 ;
+45 SET X=$$SETSTR^VALM1(DGADD(2),"",5,30)
+46 SET X=$$SETSTR^VALM1($GET(DGTMP(2)),X,35,30)
+47 DO SET(DGARY,DGLINE,X,.DGCNT)
SET DGLINE=DGLINE+1
+48 ;
+49 SET X=$$SETSTR^VALM1(DGADD(4),"",5,30)
+50 SET X=$$SETSTR^VALM1($GET(DGTMP(4)),X,35,30)
+51 DO SET(DGARY,DGLINE,X,.DGCNT)
SET DGLINE=DGLINE+1
+52 ;
+53 SET X=$$SETSTR^VALM1($PIECE(DGADD(5),U,2),"",5,30)
+54 SET X=$$SETSTR^VALM1($PIECE($GET(DGTMP(5)),U,2),X,35,30)
+55 DO SET(DGARY,DGLINE,X,.DGCNT)
SET DGLINE=DGLINE+1
+56 ;
+57 SET X=$$SETSTR^VALM1($PIECE(DGADD(11),U,2),"",5,30)
+58 SET X=$$SETSTR^VALM1($PIECE($GET(DGTMP(11)),U,2),X,35,30)
+59 DO SET(DGARY,DGLINE,X,.DGCNT)
SET DGLINE=DGLINE+1
+60 ;
+61 IF +$GET(DGTMP(9))>0
Begin DoDot:1
+62 SET X=$$SETSTR^VALM1("Effective Date: ","",35,20)
+63 SET X=$$SETSTR^VALM1($PIECE($GET(DGTMP(9)),U,2),X,55,20)
+64 DO SET(DGARY,DGLINE,X,.DGCNT)
SET DGLINE=DGLINE+1
+65 SET X=$$SETSTR^VALM1("End Date: ",X,35,20)
+66 SET X=$$SETSTR^VALM1($PIECE($GET(DGTMP(10)),U,2),X,55,20)
+67 DO SET(DGARY,DGLINE,X,.DGCNT)
SET DGLINE=DGLINE+1
End DoDot:1
+68 ;
+69 NEW XCNT
+70 FOR XCNT=DGLINE:1:VALM("LINES")
Begin DoDot:1
+71 DO SET(DGARY,DGLINE,"",.DGCNT)
SET DGLINE=DGLINE+1
End DoDot:1
+72 ;
+73 ; Inpatient Information
+74 NEW DGIN
+75 ;
+76 SET VAROOT="DGIN"
+77 DO IN5^VADPT
+78 IF DGIN(1)>0
Begin DoDot:1
+79 SET X=$$SETSTR^VALM1("Last Inpatient Movement:","",5,30)
+80 DO SET(DGARY,DGLINE,X,.DGCNT)
SET DGLINE=DGLINE+1
+81 SET X=$$SETSTR^VALM1("========================",X,5,30)
+82 DO SET(DGARY,DGLINE,X,.DGCNT)
SET DGLINE=DGLINE+1
+83 ;
+84 SET X=$$SETSTR^VALM1($PIECE(DGIN(2),U,2),X,5,20)
+85 SET X=$$SETSTR^VALM1($$FMTE^XLFDT($PIECE(DGIN(3),U,1),"D"),X,21,14)
+86 DO SET(DGARY,DGLINE,X,.DGCNT)
SET DGLINE=DGLINE+1
+87 ;
+88 SET X=""
SET X=$$SETSTR^VALM1("Room/Bed:",X,8,12)
+89 SET X=$$SETSTR^VALM1($PIECE(DGIN(6),U,2),X,20,20)
+90 SET X=$$SETSTR^VALM1("Ward:",X,40,5)
+91 SET X=$$SETSTR^VALM1($PIECE(DGIN(5),U,2),X,48,20)
+92 DO SET(DGARY,DGLINE,X,.DGCNT)
SET DGLINE=DGLINE+1
+93 DO SET(DGARY,DGLINE,"",.DGCNT)
SET DGLINE=DGLINE+1
End DoDot:1
+94 ;
+95 ; Future Scheduled Admission
+96 SET X=$$SETSTR^VALM1("Future Scheduled Admissions:","",5,30)
+97 DO SET(DGARY,DGLINE,X,.DGCNT)
SET DGLINE=DGLINE+1
+98 SET X=$$SETSTR^VALM1("============================",X,5,30)
+99 DO SET(DGARY,DGLINE,X,.DGCNT)
SET DGLINE=DGLINE+1
+100 ;
+101 SET TMPARY="^TMP(""DGFFPFU"",$J)"
+102 KILL @TMPARY
+103 DO GETFUADM^DGFFP03(DFN,TMPARY)
+104 ;
+105 SET DGDT=0
+106 FOR
SET DGDT=$ORDER(@TMPARY@(DGDT))
if 'DGDT
QUIT
Begin DoDot:1
+107 SET X=$$SETSTR^VALM1("Scheduled:","",5,10)
+108 SET X=$$SETSTR^VALM1($$FMTE^XLFDT(DGDT,"1P"),X,17,30)
+109 SET DGWARD=$PIECE(@TMPARY@(DGDT),U,8)
+110 SET X=$$SETSTR^VALM1("Ward:",X,47,5)
+111 SET X=$$SETSTR^VALM1($$GET1^DIQ(42,DGWARD,.01),X,53,80)
+112 DO SET(DGARY,DGLINE,X,.DGCNT)
SET DGLINE=DGLINE+1
End DoDot:1
+113 ;
+114 DO SET(DGARY,DGLINE,"",.DGCNT)
SET DGLINE=DGLINE+1
+115 DO SET(DGARY,DGLINE,"",.DGCNT)
SET DGLINE=DGLINE+1
+116 KILL @TMPARY
+117 ;
+118 ; Outpatient Information
+119 NEW TEMP
+120 ;
+121 SET TEMP="^TMP(""DGFFPOP"",$J)"
+122 KILL @TEMP
+123 DO GETAPT^DGFFP03(DFN,TEMP)
+124 ;
+125 SET X=""
+126 SET X=$$SETSTR^VALM1("Future Appointments:",X,5,30)
+127 DO SET(DGARY,DGLINE,X,.DGCNT)
SET DGLINE=DGLINE+1
+128 SET X=$$SETSTR^VALM1("====================",X,5,30)
+129 DO SET(DGARY,DGLINE,X,.DGCNT)
SET DGLINE=DGLINE+1
+130 ;
+131 SET DGCLN=""
+132 FOR
SET DGCLN=$ORDER(@TEMP@(DGCLN))
if DGCLN']""
QUIT
Begin DoDot:1
+133 SET X=$$SETSTR^VALM1(DGCLN,"",5,30)
+134 DO SET(DGARY,DGLINE,X,.DGCNT)
SET DGLINE=DGLINE+1
+135 SET DGDT=0
+136 FOR
SET DGDT=$ORDER(@TEMP@(DGCLN,DGDT))
if 'DGDT
QUIT
Begin DoDot:2
+137 SET X=$$SETSTR^VALM1($$FMTE^XLFDT(DGDT,"1P"),"",10,40)
+138 DO SET(DGARY,DGLINE,X,.DGCNT)
SET DGLINE=DGLINE+1
End DoDot:2
End DoDot:1
+139 KILL @TEMP
+140 DO SET(DGARY,DGLINE,"",.DGCNT)
SET DGLINE=DGLINE+1
+141 DO SET(DGARY,DGLINE,"",.DGCNT)
SET DGLINE=DGLINE+1
+142 QUIT
+143 ;
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
