source: FOIAVistA/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGPFDIV1.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: 4.4 KB
Line 
1DGPFDIV1 ;ALB/KCL - PRF ENABLE MEDICAL CENTER DIVISIONS CONT.; 5/07/05 ; 8/25/05 4:12pm
2 ;;5.3;Registration;**650**;Aug 13, 1993;Build 3
3 ;
4 ;No direct entry
5 QUIT
6 ;
7LOCK(DGIEN) ;lock MEDICAL CENTER DIVISION record
8 ;This lock function is used to prevent another process from editing
9 ;a record in the MEDICAL CENTER DIVISION (#40.8) file.
10 ;
11 ; Input:
12 ; DGIEN - (required) IEN for MEDICAL CENTER DIVISION (#40.8) file
13 ;
14 ; Output:
15 ; Function value - returns 1 on success, 0 on failure
16 ;
17 I $G(DGIEN) L +^DG(40.8,DGIEN):10
18 ;
19 Q $T
20 ;
21UNLOCK(DGIEN) ;unlock MEDICAL CENTER DIVISION record
22 ;This procedure is used to release a lock created by $$LOCK.
23 ;
24 ; Input:
25 ; DGIEN - (required) IEN for MEDICAL CENTER DIVISION (#40.8) file
26 ;
27 ; Output: none
28 ;
29 I $G(DGIEN) L -^DG(40.8,DGIEN)
30 ;
31 Q
32 ;
33GETDIV(DGIEN,DGDIV) ;retrieve PRF MEDICAL CENTER DIVISION object
34 ;This function is used to retrieve the data fields related to the
35 ;PRF Ownership Indicator from the MEDICAL CENTER DIVISION (#40.8) file
36 ;and place them in a local array.
37 ;
38 ; Input:
39 ; DGIEN - (required) ien for MEDICAL CENTER DIVISION (#40.8) file
40 ;
41 ; Output:
42 ; Function value - returns 1 on success, 0 on failure
43 ; DGDIV - local array of MEDICAL CENTER DIVISION data fields (passed
44 ; by reference)
45 ; Subscript Field#
46 ; ---------- ------
47 ; "NAME" .01
48 ; "INST" .07
49 ; "IND" 26.01
50 ; "EDITDT" 26.02
51 ; "EDITBY" 26.03
52 ;
53 N DGIENS ;ien string
54 N DGFLDS ;target root
55 N DGERR ;error root
56 N DGRSLT ;function result
57 ;
58 K DGDIV S DGDIV=""
59 S DGRSLT=0
60 ;
61 I $G(DGIEN)>0,$D(^DG(40.8,DGIEN)) D
62 . S DGIENS=DGIEN_","
63 . D GETS^DIQ(40.8,DGIENS,".01;.07;26.01;26.02;26.03","IE","DGFLDS","DGERR")
64 . Q:$D(DGERR)
65 . ;
66 . S DGDIV("NAME")=$G(DGFLDS(40.8,DGIENS,.01,"I"))_U_$G(DGFLDS(40.8,DGIENS,.01,"E"))
67 . S DGDIV("INST")=$G(DGFLDS(40.8,DGIENS,.07,"I"))_U_$G(DGFLDS(40.8,DGIENS,.07,"E"))
68 . S DGDIV("IND")=$G(DGFLDS(40.8,DGIENS,26.01,"I"))_U_$G(DGFLDS(40.8,DGIENS,26.01,"E"))
69 . S DGDIV("EDITDT")=$G(DGFLDS(40.8,DGIENS,26.02,"I"))_U_$G(DGFLDS(40.8,DGIENS,26.02,"E"))
70 . S DGDIV("EDITBY")=$G(DGFLDS(40.8,DGIENS,26.03,"I"))_U_$G(DGFLDS(40.8,DGIENS,26.03,"E"))
71 . ;
72 . ;success
73 . S DGRSLT=1
74 ;
75 Q DGRSLT
76 ;
77STODIV(DGIEN,DGIND) ;store PRF MEDICAL CENTER DIVISION object
78 ;This function is used to store the data fields related to the
79 ;PRF Ownership Indicator into the MEDICAL CENTER DIVISION (#40.8) file.
80 ;
81 ; Input:
82 ; DGIEN - (required) ien for MEDICAL CENTER DIVISION (#40.8) file
83 ; DGIND - (required) PRF Ownership Indicator [1=enable, 0=disable]
84 ;
85 ; Output:
86 ; Function value - returns 1 on success, 0 on failure
87 ;
88 ;
89 N DGERR ;error root
90 N DGFDA ;fda array
91 N DGRSLT ;function result
92 ;
93 S DGRSLT=0
94 ;
95 I $G(DGIEN)>0,$D(^DG(40.8,DGIEN)) D
96 . ;
97 . ;quit if can't convert internal value to external
98 . Q:$$EXTERNAL^DILFD(40.8,26.01,"",DGIND)']""
99 . ;
100 . ;file data
101 . S DGFDA(40.8,DGIEN_",",26.01)=DGIND ;indicator
102 . S DGFDA(40.8,DGIEN_",",26.02)=$$NOW^XLFDT() ;current date/time
103 . S DGFDA(40.8,DGIEN_",",26.03)=DUZ ;user
104 . D FILE^DIE("","DGFDA","DGERR")
105 . Q:$D(DGERR)
106 . ;
107 . ;success
108 . S DGRSLT=1
109 ;
110 Q DGRSLT
111 ;
112VIEW ;view medical center divisions
113 ;This procedure is used to view all medical center divisions within the
114 ;Medical Center Division (#40.8) file and whether or not they have been
115 ;enabled for PRF assignment ownership.
116 ;
117 ; Input: none
118 ; Output: none
119 ;
120 N DGEXIT ;exit var
121 N DGIEN ;file (#40.8) ien
122 N DGINST ;ptr to INSTITUTION file
123 N DGLINE ;display line
124 N DGOBJ ;med center division object array
125 N DGSUB ;loop subscript
126 ;
127 S $P(DGLINE,"_",66)=""
128 W @IOF
129 ;
130 F DGIEN=0:0 S DGIEN=$O(^DG(40.8,DGIEN)) D Q:'DGIEN!($G(DGEXIT))
131 . K DGOBJ
132 . I $$GETDIV(DGIEN,.DGOBJ) D
133 . . F DGSUB="NAME","IND","EDITBY","EDITDT" D
134 . . . I $P(DGOBJ(DGSUB),U,2)']"" S $P(DGOBJ(DGSUB),U,2)="n/a"
135 . . ;
136 . . S:$P(DGOBJ("IND"),U,2)="n/a" $P(DGOBJ("IND"),U,2)="DISABLED (default)"
137 . . S DGINST=+$P($G(^DG(40.8,DGIEN,0)),U,7)
138 . . S DGOBJ("ACTIVE")=$S($D(^DGPF(26.13,"AOWN",DGINST,1)):"YES",1:"NO")
139 . . ;
140 . . W !," Medical Center Division: ",$P(DGOBJ("NAME"),U,2)
141 . . W !," PRF Assignment Ownership: ",$P(DGOBJ("IND"),U,2)
142 . . W !," Edited By: ",$P(DGOBJ("EDITBY"),U,2)
143 . . W !," Edit Date/Time: ",$P(DGOBJ("EDITDT"),U,2)
144 . . W !," Active PRF Assignments: ",DGOBJ("ACTIVE")
145 . . W !,DGLINE,!
146 . . I $Y>(IOSL-5) S DGEXIT='$$CONTINUE^DGPFUT() W @IOF
147 ;
148 Q
Note: See TracBrowser for help on using the repository browser.