1 | ACKQASU6 ;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 | ;
|
---|
6 | SETPRIM(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 | ;
|
---|
48 | SETPRIMX ; exit point
|
---|
49 | Q ACKPRIM
|
---|
50 | ;
|
---|
51 | SETSCND(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 | ;
|
---|
93 | SETSCNDX ; exit point
|
---|
94 | Q ACKSCND
|
---|
95 | ;
|
---|
96 | SETSTUD(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 | ;
|
---|
138 | SETSTUDX ; exit point
|
---|
139 | Q ACKSTUD
|
---|
140 | ;
|
---|