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

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

initial load of FOIAVistA 6/30/08 version
File size: 5.9 KB
Line 
1DGPFALF ;ALB/KCL,RBS - PRF LOCAL FLAG API'S ; 4/8/04 4:03pm
2 ;;5.3;Registration;**425,554**;Aug 13, 1993
3 ;
4 ;- no direct entry
5 QUIT
6 ;
7GETLF(DGPFIEN,DGPFLF) ;retrieve a single PRF LOCAL FLAG (#26.11) record
8 ;This function returns a single flag record from the PRF LOCAL FLAG
9 ;file and returns it in an array format.
10 ;
11 ; Input:
12 ; DGPFIEN - (required) pointer to local flag record in the
13 ; PRF LOCAL FLAG (#26.11) file
14 ; DGPFLF - (required) result array passed by reference
15 ;
16 ; Output:
17 ; Function Value - returns 1 on success, 0 on failure
18 ; DGPFLF - output array containing local flag record field
19 ; values.
20 ; Subscript Field# Data
21 ; -------------- ------- -------------------
22 ; "FLAG" .01 internal^external
23 ; "STAT" .02 internal^external
24 ; "TYPE" .03 internal^external
25 ; "REVFREQ" .04 internal^external
26 ; "NOTIDAYS" .05 internal^external
27 ; "REVGRP" .06 internal^external
28 ; "TIUTITLE" .07 internal^external
29 ; "DESC",line#,0 1 character string
30 ; "PRININV",line#,0 2 character string
31 ;
32 N DGIENS ;IEN string for DIQ
33 N DGFLDS ;results array for DIQ
34 N DGERR ;error arrary for DIQ
35 N DGSUB ;pincipal investigator multiple subscript
36 N RESULT ;return function value
37 ;
38 S RESULT=0
39 ;
40 I $G(DGPFIEN)>0,$D(^DGPF(26.11,DGPFIEN)) D
41 . S DGIENS=DGPFIEN_","
42 . D GETS^DIQ(26.11,DGIENS,"**","IEZ","DGFLDS","DGERR")
43 . Q:$D(DGERR)
44 . ;
45 . ;-- build local flag array
46 . S DGPFLF("FLAG")=$G(DGFLDS(26.11,DGIENS,.01,"I"))_U_$G(DGFLDS(26.11,DGIENS,.01,"E"))
47 . S DGPFLF("STAT")=$G(DGFLDS(26.11,DGIENS,.02,"I"))_U_$G(DGFLDS(26.11,DGIENS,.02,"E"))
48 . S DGPFLF("TYPE")=$G(DGFLDS(26.11,DGIENS,.03,"I"))_U_$G(DGFLDS(26.11,DGIENS,.03,"E"))
49 . S DGPFLF("REVFREQ")=$G(DGFLDS(26.11,DGIENS,.04,"I"))_U_$G(DGFLDS(26.11,DGIENS,.04,"E"))
50 . S DGPFLF("NOTIDAYS")=$G(DGFLDS(26.11,DGIENS,.05,"I"))_U_$G(DGFLDS(26.11,DGIENS,.05,"E"))
51 . S DGPFLF("REVGRP")=$G(DGFLDS(26.11,DGIENS,.06,"I"))_U_$G(DGFLDS(26.11,DGIENS,.06,"E"))
52 . S DGPFLF("TIUTITLE")=$G(DGFLDS(26.11,DGIENS,.07,"I"))_U_$G(DGFLDS(26.11,DGIENS,.07,"E"))
53 . ;-- flag description word processing array
54 . M DGPFLF("DESC")=DGFLDS(26.11,DGIENS,1)
55 . K DGPFLF("DESC","E"),DGPFLF("DESC","I")
56 . ;-- principal investigator(s) multiple
57 . S DGSUB="" F S DGSUB=$O(DGFLDS(26.112,DGSUB)) Q:DGSUB="" D
58 . . S DGPFLF("PRININV",+DGSUB,0)=$G(DGFLDS(26.112,DGSUB,.01,"I"))_U_$G(DGFLDS(26.112,DGSUB,.01,"E"))
59 . ;
60 . S RESULT=1
61 ;
62 Q RESULT
63 ;
64FNDFLAG(DGPFFLG) ;Find Flag Name IEN
65 ; This function finds a flag record IEN using the name field.
66 ; Input:
67 ; DGPFFLG - Flag Name field (.01) value
68 ;
69 ; Output:
70 ; Function Value - Returns IEN of existing record on success, 0 on
71 ; failure
72 N DGIEN
73 I $G(DGPFFLG)["" D
74 . S DGIEN=$O(^DGPF(26.11,"B",DGPFFLG,0))
75 ;
76 Q $S($G(DGIEN)>0:DGIEN,1:0)
77 ;
78STOFLAG(DGPFLF,DGPFERR) ;store a single PRF LOCAL FLAG (#26.11) file record
79 ;
80 ; Input:
81 ; DGPFLF - (required) array of values to be filed (see GETLF tag
82 ; above for valid array structure)
83 ; DGPFERR - (optional) passed by reference to contain error messages
84 ;
85 ; Output:
86 ; Function Value - Returns IEN of record on success, 0 on failure
87 ; DGPFERR - Undefined on success, error message on failure
88 ;
89 N DGSUB,DGFLD,DGIEN,DGIENS,DGFDA,DGFDAIEN,DGERR
90 ;
91 F DGSUB="FLAG","STAT","TYPE","REVFREQ","NOTIDAYS","REVGRP","TIUTITLE" D
92 . S DGFLD(DGSUB)=$P($G(DGPFLF(DGSUB)),U)
93 I $D(DGPFLF("DESC")) M DGFLD("DESC")=DGPFLF("DESC")
94 I $D(DGPFLF("PRININV")) M DGFLD("PRININV")=DGPFLF("PRININV")
95 I $$VALID^DGPFUT("DGPFALF1",26.11,.DGFLD,.DGPFERR) D
96 . ;
97 . ;if name change lookup on original name, otherwise lookup on new name
98 . S DGIEN=$$FNDFLAG^DGPFALF($S($G(DGPFLF("OLDFLAG"))]"":DGPFLF("OLDFLAG"),1:DGFLD("FLAG")))
99 . ;the "?+" on an existing record will do LAYGO to lookup and add new
100 . ; entries. This was needed for adding another entry to the
101 . ; Principal Investigator(s) multiple (#26.112)
102 . I DGIEN S DGIENS=DGIEN_"," ;EDIT existing record
103 . E S DGIENS="+1," ;ADD new record
104 . S DGFDA(26.11,DGIENS,.01)=DGFLD("FLAG")
105 . S DGFDA(26.11,DGIENS,.02)=DGFLD("STAT")
106 . S DGFDA(26.11,DGIENS,.03)=DGFLD("TYPE")
107 . S DGFDA(26.11,DGIENS,.04)=DGFLD("REVFREQ")
108 . S DGFDA(26.11,DGIENS,.05)=DGFLD("NOTIDAYS")
109 . S DGFDA(26.11,DGIENS,.06)=DGFLD("REVGRP")
110 . S DGFDA(26.11,DGIENS,.07)=DGFLD("TIUTITLE")
111 . S DGFDA(26.11,DGIENS,1)="DGFLD(""DESC"")"
112 . ;-- principal investigator(s) multiple
113 . I $D(DGFLD("PRININV")) D PRININV(+DGIEN,.DGFDA)
114 . ;
115 . D UPDATE^DIE("","DGFDA","DGFDAIEN","DGERR")
116 . I '$D(DGERR),'DGIEN S DGIEN=$G(DGFDAIEN(1))
117 ;
118 Q $S($G(DGIEN)>0:DGIEN,1:0)
119 ;
120PRININV(DGPFIEN,DGFDA) ; setup principal investigator(s) multiple (#26.112)
121 ; Input:
122 ; DGPFIEN - value will indicate to EDIT or ADD a New Record
123 ; IEN# = IEN of existing entry - Edit to existing Record
124 ; 0 = Add New Record
125 ; DGFDA - array used by FileMan (passed by reference)
126 ;
127 ; Output:
128 ; DGFDA array subscript entries for "PRININV"
129 ;
130 ; The DGFDA FDA_ROOT array needs the "?+" on an existing IEN so
131 ; that FileMan will do LAYGO to lookup and add new entires.
132 ; This was needed for adding another entry to an existing
133 ; Principal Investigator(s) multiple (#26.112) field.
134 ;
135 S DGPFIEN=+$G(DGPFIEN)
136 N DGSUB,DGIENS
137 ;
138 S DGSUB=0 F S DGSUB=$O(DGFLD("PRININV",DGSUB)) Q:DGSUB="" D
139 . I DGPFIEN D ;existing record
140 . . S DGIENS=DGSUB_","_DGPFIEN_"," ;delete
141 . . Q:DGFLD("PRININV",DGSUB,0)="@"
142 . . S DGIENS="?+"_DGIENS ;non-delete uses LAYGO
143 . E S DGIENS="+"_(DGSUB+1)_",+1," ;new record
144 . ;
145 . S DGFDA(26.112,DGIENS,.01)=$P(DGFLD("PRININV",DGSUB,0),U)
146 ;
147 Q
Note: See TracBrowser for help on using the repository browser.