source: FOIAVistA/tag/r/QUASAR-ACKQ/ACKQASU6.m@ 1789

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

initial load of FOIAVistA 6/30/08 version
File size: 5.4 KB
Line 
1ACKQASU6 ;HCIOFO/AG - New/Edit Visit Utilities ; 04/01/99
2 ;;3.0;QUASAR;;Feb 11, 2000
3 ;Per VHA Directive 10-93-142, this routine SHOULD NOT be modified.
4 ;
5 ;
6SETPRIM(ACKVIEN,ACKQPRV) ; add primary provider to A&SP Clinic Visit
7 ; inputs: ACKVIEN - A&SP visit ien
8 ; ACKQPRV - provider ien from Quasar or null
9 ; outputs: 1^ - everything ok
10 ; 0^xxxxxxx - update failed (reason=xxxxxx)
11 ; NB. This function checks the visit date for the visit against the
12 ; activation and inactivation dates for the Provider. it therefore
13 ; assumes that the visit date has already been filed.
14 N ACKPRIM,ACKPRVN,ACKARR,ACKVD,ACKPACT,ACKPINA,ACKSTAT
15 S ACKPRIM="" ; return string
16 ;
17 S ACKPRVN=ACKQPRV
18 ;
19 ; if not found then set error message and exit
20 I 'ACKPRVN D G SETPRIMX
21 . S ACKPRIM="0^Provider not defined for Audiology and Speech Pathology"
22 ;
23 ; if defined get status (clinician/fee basis/other provider/student)
24 S ACKSTAT=$$GET1^DIQ(509850.3,ACKPRVN_",",.02,"I")
25 ;
26 ; if not a clinician or fee basis then not allowed as primary provider
27 I ACKSTAT'="C",ACKSTAT'="F" D G SETPRIMX
28 . S ACKPRIM="0^Primary Provider must be a Clinician or Fee Basis Clinician"
29 ;
30 ; get the visit date and the provider activation/inactivation dates
31 S ACKVD=$$GET1^DIQ(509850.6,ACKVIEN_",",.01,"I")
32 S ACKPACT=$$GET1^DIQ(509850.3,ACKPRVN_",",.03,"I")
33 S ACKPINA=$$GET1^DIQ(509850.3,ACKPRVN_",",.04,"I")
34 ;
35 ; if the provider is not active then set error and exit
36 I (ACKPACT="")!(ACKPACT>ACKVD) D G SETPRIMX
37 . S ACKPRIM="0^Provider not Active on the Visit Date"
38 ;
39 ; if the provider is inactive then set error and exit
40 I ACKPINA'="",ACKPINA<ACKVD D G SETPRIMX
41 . S ACKPRIM="0^Provider made Inactive prior to the Visit Date"
42 ;
43 ; all ok, then add the provider to the visit
44 S ACKARR(509850.6,ACKVIEN_",",6)=ACKPRVN
45 D FILE^DIE("","ACKARR","")
46 S ACKPRIM="1^" ; set return flag to OK
47 ;
48SETPRIMX ; exit point
49 Q ACKPRIM
50 ;
51SETSCND(ACKVIEN,ACKQPRV) ; add secondary provider to A&SP Clinic Visit
52 ; inputs: ACKVIEN - A&SP visit ien
53 ; ACKQPRV - provider ien from Quasar file or null
54 ; outputs: 1^ - everything ok
55 ; 0^xxxxxxx - update failed (reason=xxxxxx)
56 ; NB. This function checks the visit date for the visit against the
57 ; activation and inactivation dates for the Provider. it therefore
58 ; assumes that the visit date has already been filed.
59 N ACKSCND,ACKPRVN,ACKARR,ACKVD,ACKPACT,ACKPINA,ACKSTAT
60 S ACKSCND="" ; return string
61 ;
62 S ACKPRVN=ACKQPRV
63 ;
64 ; if not found then set error message and exit
65 I 'ACKPRVN D G SETSCNDX
66 . S ACKSCND="0^Provider not defined for Audiology and Speech Pathology"
67 ;
68 ; if found, get status (clinician/fee basis/other provider/student)
69 S ACKSTAT=$$GET1^DIQ(509850.3,ACKPRVN_",",.02,"I")
70 ;
71 ; if not a clinician, fee basis or other provider then not allowed as second provider
72 I ACKSTAT'="C",ACKSTAT'="F",ACKSTAT'="O" D G SETSCNDX
73 . S ACKSCND="0^Secondary Provider must be a Clinician, Fee Basis or Other Provider"
74 ;
75 ; get the visit date and the provider activation/inactivation dates
76 S ACKVD=$$GET1^DIQ(509850.6,ACKVIEN_",",.01,"I")
77 S ACKPACT=$$GET1^DIQ(509850.3,ACKPRVN_",",.03,"I")
78 S ACKPINA=$$GET1^DIQ(509850.3,ACKPRVN_",",.04,"I")
79 ;
80 ; if the provider is not active then set error and exit
81 I (ACKPACT="")!(ACKPACT>ACKVD) D G SETSCNDX
82 . S ACKSCND="0^Provider not Active on the Visit Date"
83 ;
84 ; if the provider is inactive then set error and exit
85 I ACKPINA'="",ACKPINA<ACKVD D G SETSCNDX
86 . S ACKSCND="0^Provider made Inactive prior to the Visit Date"
87 ;
88 ; all ok, then add the provider to the visit
89 S ACKARR(509850.66,"+1,"_ACKVIEN_",",.01)=ACKPRVN
90 D UPDATE^DIE("","ACKARR","","")
91 S ACKSCND="1^" ; set return flag to OK
92 ;
93SETSCNDX ; exit point
94 Q ACKSCND
95 ;
96SETSTUD(ACKVIEN,ACKQPRV) ; add student to A&SP Clinic Visit
97 ; inputs: ACKVIEN - A&SP visit ien
98 ; ACKQPRV - provider ien from Quasar file or null
99 ; outputs: 1^ - everything ok
100 ; 0^xxxxxxx - update failed (reason=xxxxxx)
101 ; NB. This function checks the visit date for the visit against the
102 ; activation and inactivation dates for the Provider. it therefore
103 ; assumes that the visit date has already been filed.
104 N ACKSTUD,ACKPRVN,ACKARR,ACKVD,ACKPACT,ACKPINA,ACKSTAT
105 S ACKSTUD="" ; return string
106 ;
107 S ACKPRVN=ACKQPRV
108 ;
109 ; if not found then set error message and exit
110 I 'ACKPRVN D G SETSTUDX
111 . S ACKSTUD="0^Provider not defined for Audiology and Speech Pathology"
112 ;
113 ; if found, get status (clinician/fee basis/other provider/student)
114 S ACKSTAT=$$GET1^DIQ(509850.3,ACKPRVN_",",.02,"I")
115 ;
116 ; if not a student then set error message and quit
117 I ACKSTAT'="S" D G SETSTUDX
118 . S ACKSTUD="0^Provider must be defined as a Student in the A&SP Staff File."
119 ;
120 ; get the visit date and the provider activation/inactivation dates
121 S ACKVD=$$GET1^DIQ(509850.6,ACKVIEN_",",.01,"I")
122 S ACKPACT=$$GET1^DIQ(509850.3,ACKPRVN_",",.03,"I")
123 S ACKPINA=$$GET1^DIQ(509850.3,ACKPRVN_",",.04,"I")
124 ;
125 ; if the provider is not active then set error and exit
126 I (ACKPACT="")!(ACKPACT>ACKVD) D G SETSTUDX
127 . S ACKSTUD="0^Provider not Active on the Visit Date"
128 ;
129 ; if the provider is inactive then set error and exit
130 I ACKPINA'="",ACKPINA<ACKVD D G SETSTUDX
131 . S ACKSTUD="0^Provider made Inactive prior to the Visit Date"
132 ;
133 ; all ok, then add the provider to the visit
134 S ACKARR(509850.6,ACKVIEN_",",7)=ACKPRVN
135 D FILE^DIE("","ACKARR","")
136 S ACKSTUD="1^" ; set return flag to OK
137 ;
138SETSTUDX ; exit point
139 Q ACKSTUD
140 ;
Note: See TracBrowser for help on using the repository browser.