source: WorldVistAEHR/trunk/r/QUASAR-ACKQ/ACKQASU5.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: 6.8 KB
Line 
1ACKQASU5 ;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 ;
5SETDIAG(ACKVIEN,ACKICD,ACKDPRIM) ; add ICD9 code to A&SP Clinic Visit
6 ; inputs: ACKVIEN - A&SP visit ien
7 ; ACKICD - ICD9 Diagnosis ien from ICD9 file
8 ; ACKDPRIM - Primary Diag. flag
9 ; outputs: 1^ - everything ok
10 ; 0^xxxxxxx - update failed (reason=xxxxxx)
11 ; NB. This function checks the Stop Code for the visit against the
12 ; valid stop codes for the Diagnosis. It therefore assumes that the
13 ; visit stop code has already been filed.
14 N ACKDIAG,ACKICDN,ACKE,ACKARR,ACKSTAT,ACKVSC,ACKDSC
15 ;
16 S ACKDIAG=""
17 ; find the ICD code on the QUASAR file
18 S ACKICDN=$$FIND1^DIC(509850.1,",","Q",ACKICD,"","","")
19 ;
20 ; if not found then set error message and exit
21 I 'ACKICDN D G SETDIAGX
22 . S ACKDIAG="0^Diagnosis not valid for Audiology and Speech Pathology"
23 ;
24 ; if found, get status (active/inactive)
25 S ACKSTAT=$$GET1^DIQ(509850.1,ACKICDN_",",.06,"I")
26 ;
27 ; if inactive then set error message and exit
28 I ACKSTAT'=1 D G SETDIAGX
29 . S ACKDIAG="0^Diagnosis not Active"
30 ;
31 ; get the stop code for the visit and the stop code for the Diagnosis
32 S ACKVSC=$$GET1^DIQ(509850.6,ACKVIEN_",",4,"I")
33 S ACKDSC=$$GET1^DIQ(509850.1,ACKICDN_",",.04,"I")
34 ;
35 ; if diagnosis is for different stop code then set error and exit
36 I ACKDSC="S",(ACKVSC="A")!(ACKVSC="AT") D G SETDIAGX
37 . S ACKDIAG="0^Diagnosis is not valid for an Audiology Visit"
38 I ACKDSC="A",(ACKVSC="S")!(ACKVSC="ST") D G SETDIAGX
39 . S ACKDIAG="0^Diagnosis is not valid for a Speech Pathology Visit"
40 ;
41 ; see if the code already exists on the visit
42 S ACKE=$$FIND1^DIC(509850.63,","_ACKVIEN_",","Q",ACKICDN,"","","")
43 ;
44 ; if it does already exist on the visit then set error message and exit
45 ; (null value also is an error as this means an error occurred in the lookup)
46 I ACKE'=0 D G SETDIAGX
47 . S ACKDIAG="0^Duplicate Diagnosis"
48 ;
49 ; all ok, then add the diagnosis to the visit
50 S ACKARR(509850.63,"+1,"_ACKVIEN_",",.01)=ACKICDN
51 I ACKDPRIM S ACKARR(509850.63,"+1,"_ACKVIEN_",",.12)=1
52 D UPDATE^DIE("","ACKARR","","")
53 S ACKDIAG="1^" ; set return flag to OK
54 ;
55SETDIAGX ; exit point
56 Q ACKDIAG
57 ;
58SETPROC(ACKVIEN,ACKCPT,ACKQTY,ACKPPRV) ; add CPT code to A&SP Clinic Visit
59 ; inputs: ACKVIEN - A&SP visit ien
60 ; ACKCPT - CPT Procedure ien from ICPT file
61 ; ACKQTY - number of time procedure was performed (opt)
62 ; ACKPPRV - Procedure Provider
63 ; outputs: n^ - everything ok (n=cpt ien on visit)
64 ; 0^xxxxxxx - update failed (reason=xxxxxx)
65 ; NB. This function checks the Stop Code for the visit against the
66 ; valid stop codes for the procedure. It therefore assumes that the
67 ; visit stop code has already been filed.
68 N ACKPROC,ACKCPTN,ACKE,ACKARR,ACKSTAT,ACKVSC,ACKPSC,ACKIEN
69 ;
70 ; initialise return variable and procedure quantity
71 S ACKPROC="",ACKQTY=$S(+$G(ACKQTY)=0:1,1:ACKQTY)
72 ;
73 ; find the ICD code on the QUASAR file
74 S ACKCPTN=$$FIND1^DIC(509850.4,",","Q",ACKCPT,"","","")
75 ;
76 ; if not found then set error message and exit
77 I 'ACKCPTN D G SETPROCX
78 . S ACKPROC="0^Procedure not valid for Audiology and Speech Pathology"
79 ;
80 ; if found, get status (active/inactive)
81 S ACKSTAT=$$GET1^DIQ(509850.4,ACKCPTN_",",.04,"I")
82 ;
83 ; if inactive then set error message and exit
84 I ACKSTAT'=1 D G SETPROCX
85 . S ACKPROC="0^Procedure not Active"
86 ;
87 ; get the stop code for the visit and the stop code for the Procedure
88 S ACKVSC=$$GET1^DIQ(509850.6,ACKVIEN_",",4,"I")
89 S ACKPSC=$$GET1^DIQ(509850.4,ACKCPTN_",",.02,"I")
90 ;
91 ; if procedure is for different stop code then set error and exit
92 I ACKPSC="S",(ACKVSC="A")!(ACKVSC="AT") D G SETPROCX
93 . S ACKPROC="0^Procedure is not valid for an Audiology Visit"
94 I ACKPSC="A",(ACKVSC="S")!(ACKVSC="ST") D G SETPROCX
95 . S ACKPROC="0^Procedure is not valid for a Speech Pathology Visit"
96 ;
97 ; all ok, then add the procedure to the visit
98 S ACKARR(509850.61,"+1,"_ACKVIEN_",",.01)=ACKCPTN
99 S ACKARR(509850.61,"+1,"_ACKVIEN_",",.03)=ACKQTY
100 S ACKARR(509850.61,"+1,"_ACKVIEN_",",.05)=ACKPPRV
101 K ACKIEN
102 D UPDATE^DIE("","ACKARR","ACKIEN","")
103 S ACKPROC=+$G(ACKIEN(1))_"^" ; set return flag to OK
104 ;
105SETPROCX ; exit point
106 Q ACKPROC
107 ;
108SETMDFR(ACKVIEN,ACKPIEN,ACKMOD) ; add modifier to A&SP Clinic Visit
109 ; inputs: ACKVIEN - A&SP visit ien
110 ; ACKPIEN - Procedure ien from visit file
111 ; ACKMOD - modifier (ien from file 81.3)
112 ; outputs: 1^ - everything ok
113 ; 0^xxxxxxx - update failed (reason=xxxxxx)
114 N ACKMDFR,ACKMODN,ACKARR,ACKSTAT
115 ;
116 ; initialise return variable
117 S ACKMDFR=""
118 ;
119 ; find the modifier code on the QUASAR file
120 S ACKMODN=$$FIND1^DIC(509850.5,",","Q",ACKMOD,"","","")
121 ;
122 ; if not found then set error message and exit
123 I 'ACKMODN D G SETMODX
124 . S ACKMOD="0^Modifier not valid for Audiology and Speech Pathology"
125 ;
126 ; if found, get status (active/inactive)
127 S ACKSTAT=$$GET1^DIQ(509850.5,ACKMODN_",",1,"I")
128 ;
129 ; if inactive then set error message and exit
130 I ACKSTAT'=1 D G SETMODX
131 . S ACKMOD="0^Modifier not Active"
132 ;
133 ; all ok, then add the modifier to the visit and procedure
134 S ACKARR(509850.64,"+1,"_ACKPIEN_","_ACKVIEN_",",.01)=ACKMODN
135 D UPDATE^DIE("","ACKARR","","")
136 S ACKMOD="1^" ; set return flag to OK
137 ;
138SETMODX ; exit point
139 Q ACKMOD
140 ;
141 ;
142PRIMARY(ACKVIEN,ACKDD) ; Does the visit contain a Primary Diagnosis
143 ; Input - Visit IEN
144 ; Output - 1=Visit has a Primary Diagnosis
145 ; 0=Visit Does not have a Primary Diagnosis
146 ; or User editing diagnosis that is the Primary
147 ;
148 I ACKDD'="",$$GET1^DIQ(509850.63,ACKDD_","_ACKVIEN_",",".12","I")=1 K ACKDD Q 0
149 N ACKFLAG,ACKK3
150 D LIST^DIC(509850.63,","_ACKVIEN_",",".12","I","*","","","","","","ACKDIAG")
151 S ACKK3=0,ACKFLAG=0
152 F S ACKK3=$O(ACKDIAG("DILIST","ID",ACKK3)) Q:ACKK3=""!(ACKFLAG) D
153 . I ACKDIAG("DILIST","ID",ACKK3,".12")=1 S ACKFLAG=1
154 K ACKDD
155 Q ACKFLAG
156 ;
157POSTDIAG(ACKVIEN) ; After Diagnosis codes have been entered check that
158 ; one is a Primary diagnosis.
159 ;
160 ; Input - Visit IEN
161 ; Output - 1=A primary has been entered
162 ; 0=A Primary needs to be entered
163 ;
164 I $$PRIMARY(ACKVIEN,"") Q 1
165 W !!,"One of the Diagnosis codes entered must be defined as the Primary Diagnosis."
166 Q 0
167 ;
168TIMECHEK(ACKVIEN,ACKPARAM) ; Prevet user from editing a Visit Time
169 ;
170 ; Input ACKVIEN - Visit IEN
171 ; ACKPARMAM - 1=Called from Template
172 ; Null=Called from input Tranform of Visit Time
173 ; Output 0=Visit has No Visit Time
174 ; 1=Visit has Visit Time
175 ;
176 N ACKQTME
177 S ACKQTME=$$GET1^DIQ(509850.6,ACKVIEN,55,"E")
178 I ACKQTME="" Q 0
179 I ACKPARAM=1 D
180 . W !,"APPOINTMENT TIME : "_ACKQTME_" (Uneditable)"
181 K ACKPARAM
182 Q 1
183 ;
184TIMERR ;
185 W !," NOTE - Once entered this field cannot be edited."
186 W !," If you wish to edit the Visit Time use the Delete Visit option then",!
187 W " re-enter the visit with the correct Visit Time.",!
188 ;
Note: See TracBrowser for help on using the repository browser.