source: WorldVistAEHR/trunk/r/ENGINEERING-EN/ENPROJF.m@ 701

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

initial load of WorldVistAEHR
File size: 3.3 KB
Line 
1ENPROJF ;WISC/SAB-Project Tracking Enter/Edit Form Code ;9/12/97
2 ;;7.0;ENGINEERING;**28**;Aug 17, 1993
3 Q
4BASEPR ;Block ENPRBASE pre-action
5 ; set up variables used by DD screens of fields on block
6 S ENFT=$$GET^DDSVAL(6925,DA,158)
7 S ENPR=$$GET^DDSVAL(6925,DA,155)
8 S ENPCI=$$GET^DDSVAL(6925,DA,158.1)
9 ; check fields for applicability - If N/A then delete & make uneditable
10 ; bonus category n/a?
11 I "^NR^SL^"'[(U_ENPR_U) D PUT^DDSVAL(6925,DA,158.8,"@"),UNED^DDSUTL("BONUS","","",1)
12 ; epa reportable n/a?
13 I "NR"'=ENPR D PUT^DDSVAL(6925,DA,158.6,"@"),UNED^DDSUTL("EPAR","","",1)
14 ; epa reporting category n/a?
15 I $$GET^DDSVAL(6925,DA,158.6)'="Y" D PUT^DDSVAL(6925,DA,158.7,"@"),UNED^DDSUTL("EPAC","","",1)
16 Q
17 ;
18PRPSC ;Block ENPRBASE Field PROGRAM post-action on change
19 ; check fields for applicability - If N/A then delete & make uneditable
20 ; bonus category field?
21 I "^NR^SL^"[(U_X_U) D UNED^DDSUTL("BONUS","","",0)
22 I "^NR^SL^"'[(U_X_U) D PUT^DDSVAL(6925,DA,158.8,"@"),UNED^DDSUTL("BONUS","","",1)
23 ; epa reportable field?
24 I "NR"=X D UNED^DDSUTL("EPAR","","",0)
25 I "NR"'=X D
26 . D PUT^DDSVAL(6925,DA,158.6,"@"),UNED^DDSUTL("EPAR","","",1)
27 . D PUT^DDSVAL(6925,DA,158.7,"@"),UNED^DDSUTL("EPAC","","",1)
28 ; if existing program changed, delete project & budget categories
29 I DDSOLD]"" D
30 . N ENTXT
31 . S ENTXT="Please enter appropriate Project and Budget Categories for the new Program."
32 . D HLP^DDSUTL(.ENTXT)
33 Q
34 ;
35PCPSC ;Block ENPRBASE Field PROJECT CATEGORY post-action on change
36 ; trigger budget catgory field
37 I X]"",$G(ENPR)]"",$D(^OFM(7336.8,X,1))#10 D
38 . N ENBC,ENBCI,ENTXT
39 . S ENBCI=$P(^OFM(7336.8,X,1),U,$F("MA,MI,MM,NR,",ENPR)\3)
40 . S ENBCI(0)=$$GET^DDSVAL(6925,DA,158.2)
41 . Q:ENBCI=ENBCI(0)!'ENBCI
42 . S ENBC(0)=$$GET^DDSVAL(6925,DA,158.2,"","E")
43 . D PUT^DDSVAL(6925,DA,158.2,ENBCI,"","I")
44 . S ENTXT="The Budget Category has automatically been changed to the default value for the new project category."
45 . I ENBC(0)]"" S ENTXT=ENTXT_" (The previous value was "_ENBC(0)_")."
46 . D HLP^DDSUTL(.ENTXT)
47 Q
48 ;
49RPNPSC ;Block ENPRCH Field 'Reload Previous Progress Note' postaction on change
50 D:X
51 . S ENOTE=$$GET^DDSVAL(6925,DA,146.1)
52 . I ENOTE']"" D HLP^DDSUTL("Previous Progress Note not found.") Q
53 . D PUT^DDSVAL(6925,DA,146,ENOTE)
54 D PUT^DDSVALF("LOADNOTE","","","") ; clear form only field
55 Q
56 ;
57NHPR ;Page pre-action for pages contains blocks ENPRNHCU, ENPRNHCUCONV
58 ; Inform user when this page must be populated
59 N ENCAT,ENFT,ENPR
60 S ENFT=$$GET^DDSVAL(6925,DA,158)
61 S ENCAT="",ENPR=$$GET^DDSVAL(6925,DA,155)
62 I "^NR^SL^"[(U_ENPR_U) S ENCAT=$$GET^DDSVAL(6925,DA,158.8,"","E")
63 I "^MA^MI^MM^"[(U_ENPR_U) S ENCAT=$$GET^DDSVAL(6925,DA,158.1,"","E")
64 I ENFT'="VHA"!(ENCAT'["NHCU") D HLP^DDSUTL("This page is optional since the project category is not NHCU.")
65 I ENFT="VHA",ENCAT["NHCU" D HLP^DDSUTL("The NHCU data must be entered since the project category is NHCU.")
66 Q
67 ;
68MSL(DA) ; Milestone List Extrinsic Function
69 ; Returns value with pieces (true/false) which indicate applicability
70 ; of the corresponding 22 milestones
71 N ENAM,ENCM,ENCAF,ENPR,ENX
72 S ENPR=$$GET^DDSVAL(6925,DA,155) ; program
73 S ENAM=$$GET^DDSVAL(6925,DA,7,"","E") ; a/e (design) method
74 S ENCM=$$GET^DDSVAL(6925,DA,8,"","E") ; construction method
75 S ENCAF=$$GET^DDSVAL(6925,DA,4,"","E") ; construction approved funding
76 D MSLAP^ENPRUTL
77 Q ENX
78 ;
79 ;ENPROJF
Note: See TracBrowser for help on using the repository browser.