source: FOIAVistA/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGFFPLM1.m@ 1208

Last change on this file since 1208 was 628, checked in by George Lilly, 15 years ago

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