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

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

initial load of FOIAVistA 6/30/08 version

File size: 1.7 KB
Line 
1DGMTHL ;ALB/CJM,SCG - Hardship Determinations - List Manager Screen; 1/02/2002
2 ;;5.3;Registration;**182,344,435,467**;08/13/93
3 ;
4HARDSHIP ;Entry point for hardships
5 ; Input -- None
6 ; Output -- None
7 N DFN,DGSITE,MTIEN,SGHRD
8 ;
9 ;Get Patient file (#2) IEN - DFN
10 D GETPAT^DGRPTU(,,.DFN,) G ENQ:DFN<0
11 N DGMDOD S DGMDOD=""
12 I $P($G(^DPT(DFN,.35)),U)'="" S DGMDOD=$P(^DPT(DFN,.35),U)
13 I $G(DGMDOD) W !,"Patient died on: ",$$FMTE^XLFDT(DGMDOD,"1D") Q
14 ;
15 S (MTIEN,SGHRD)=""
16 S MTIEN=$$FIND^DGMTH(DFN,DT)
17 S:MTIEN SGHRD=$P($G(^DGMT(408.31,MTIEN,2)),U,4)
18 S DGSITE=$$INST^DGENU()
19 I SGHRD,DGSITE'=SGHRD D Q
20 .W !!?10,"A Hardship has been granted for ",$P(^DPT(DFN,0),U),"."
21 .W !?10,"Only the site granting the Hardship may edit it."
22 .W !?10,"Please, contact ",$P($G(^DIC(4,SGHRD,0)),U)," to edit the record.",!
23 .N DIR S DIR(0)="FAO",DIR("A")="Enter <RETURN> to continue." D ^DIR
24 ;
25 ;Load patient enrollment screen
26 D EN(DFN)
27ENQ Q
28 ;
29EN(DFN) ;Entry point for the DGMT HARDSHIP List Template
30 ; Input -- DFN Patient IEN
31 ; Output -- None
32 ;
33 Q:'$G(DFN)
34 N HARDSHIP
35 D WAIT^DICD
36 D EN^VALM("DGMTH HARDSHIP")
37 Q
38 ;
39INIT ;Init variables and list array
40 N MTIEN
41 S MTIEN=$$FIND^DGMTH(DFN,DT)
42 I $$GET^DGMTH(MTIEN,.HARDSHIP) ;setup hardship array
43 D CLEAN^VALM10
44 S VALMCNT=0
45 D EN^DGMTHL1("DGMTH HARDSHIP",.HARDSHIP,.VALMCNT)
46 Q
47 ;
48HELP ;Help code
49 S X="?" D DISP^XQORM1 W !!
50 Q
51 ;
52EXIT ;Exit code
53 D CLEAN^VALM10
54 D CLEAR^VALM1
55 Q
56 ;
57EXPND ;Expand code
58 Q
59 ;
60HDR ;Header code
61 N X,VA,VAERR
62 D PID^VADPT
63 S VALMHDR(1)=$E("Patient: "_$P($G(^DPT(DFN,0)),U),1,30)_" ("_VA("BID")_")"
64 S X=$S('$D(^DPT(DFN,"TYPE")):"PATIENT TYPE UNKNOWN",$D(^DG(391,+^("TYPE"),0)):$P(^(0),U,1),1:"PATIENT TYPE UNKNOWN")
65 S VALMHDR(1)=$$SETSTR^VALM1(X,VALMHDR(1),60,80)
66 Q
Note: See TracBrowser for help on using the repository browser.