- 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