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