source: WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SDPFSS.m@ 1147

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

initial load of WorldVistAEHR

File size: 5.5 KB
Line 
1SDPFSS ;ALB/SCK - Patient Financial Services System ;11/24/0622-APR-2005
2 ;;5.3;Scheduling;**430,502**;Aug 13, 1993 ;Build 14
3 ; Modified from FOIA VISTA,
4 ; Copyright (C) 2007 WorldVistA
5 ;
6 ; This program is free software; you can redistribute it and/or modify
7 ; it under the terms of the GNU General Public License as published by
8 ; the Free Software Foundation; either version 2 of the License, or
9 ; (at your option) any later version.
10 ;
11 ; This program is distributed in the hope that it will be useful,
12 ; but WITHOUT ANY WARRANTY; without even the implied warranty of
13 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 ; GNU General Public License for more details.
15 ;
16 ; You should have received a copy of the GNU General Public License
17 ; along with this program; if not, write to the Free Software
18 ; Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
19 ;
20 ;
21 Q
22 ;
23EVENT ; Entry point for PFSS Protocol event. This procedure will manage the IBB event actions.
24 ;
25 N SDEVENT,SDTEST,SDBEFORE,SDAFTER,SDMSG,SDARRAY,SDCNT,SDPRV,SDERR,SDERRMSG,SDNODE,SDOK
26 N IBBDFN,IBBAPLR,IBBEVENT,IBBPV1,IBBPV2,IBBARFN
27 ;
28 ; Check conditions before proceeding
29 Q:'$G(DFN)
30 ; VWSD LOCAL MOD HERE SDVWNVAI VARIABLE, SEE DEFINITION AT VWSD LOCAL MOD BELOW
31 I $D(SDVWNVAI) G OVER
32 Q:'$$CHECK
33OVER ;
34 ;END LOCAL MOD
35 Q:$$TESTPAT^VADPT(DFN)
36 ;VWSD LOCAl MOD
37 ; Call the ICN API to generate an ICN if one does not exist for the patient.
38 ;VWSD SDVWNVAI VARIABLE -LOCAL MOD FOR disabling the need for ICN or use of other ICN system for non-VA system
39 S SDOK=$$ICNLC^MPIF001(DFN)
40 I $D(SDVWNVAI) G OVER1
41 I (SDOK<0) D
42 . D ERRMSG^SDPFSS2(SDOK)
43 ;
44OVER1 ;
45 ;END LOCAL MOD
46 ; Get event type
47 S SDEVENT=$S($D(SDAMEVT):$$GET1^DIQ(409.66,SDAMEVT,.01),1:"OTHER")
48 I SDEVENT="CHECK-OUT",+$G(SDPFSFLG) S SDEVENT="DELETE CO"
49 ;
50 S SDBEFORE=$P($G(SDATA("BEFORE","STATUS")),U,3)
51 S SDAFTER=$P($G(SDATA("AFTER","STATUS")),U,3)
52 ;
53 I SDEVENT="CHECK-IN" D
54 . I SDBEFORE="ACT REQ/CHECKED IN"&(SDAFTER["NO ACTION TAKEN") S SDEVENT="DELETE CI"
55 ;
56 I SDEVENT="NO-SHOW" D
57 . I SDBEFORE="NO-SHOW"&(SDAFTER["NO ACTION TAKEN") S SDEVENT="DELETE NS"
58 ;
59 S IBBDFN=DFN
60 S IBBAPLR=""
61 S IBBEVENT=$$GETEVT^SDPFSS2(SDEVENT)
62 ;
63 ; Call the Scheduling Appointment Data API to retrieve appointment data
64 K ^TMP($J,"SDAMA301")
65 S SDARRAY(1)=$G(SDT)_";"_$G(SDT)
66 S SDARRAY(2)=$G(SDCL)
67 S SDARRAY(4)=$G(DFN)
68 S SDARRAY("FLDS")="1;2;3;8;9;10;11;13;14;15;16;17;18"
69 S SDCNT=$$SDAPI^SDAMA301(.SDARRAY)
70 ;
71 ; check for any errors in the TMP global
72 I SDCNT<0 D
73 . S SDERR=$O(^TMP($J,"SDAMA301",0))
74 . I SDERR D
75 . . S SDERRMSG=^TMP($J,"SDAMA301",SDERR)
76 . . S SDERR=SDERR_"^"_SDERRMSG
77 . E D
78 . . S SDERR="-1^Undefined error returned by SDAPI"
79 . D ERRMSG^SDPFSS2(SDERR)
80 . ; Null out the data global for further processing
81 . S ^TMP($J,"SDAMA301",DFN,SDCL,SDT)=""
82 ;
83 I SDCNT=0 D
84 . S SDERR="-1^No appointments were returned by SDAPI"_"^"_DFN_"^"_SDT_"^"_SDCL
85 . D ERRMSG^SDPFSS2(SDERR)
86 ;
87 ; Build data arrays for PFSS Account API
88 S SDNODE=$G(^TMP($J,"SDAMA301",DFN,SDCL,SDT))
89 S IBBPV1(2)="O"
90 S IBBPV1(3)=SDCL
91 S IBBPV1(4)=+$P(SDNODE,U,10)
92 S IBBPV1(10)=+$P(SDNODE,U,18)
93 S IBBPV1(18)=$P($P(SDNODE,U,13),";",1)
94 S IBBPV1(51)=$P(SDNODE,U,15)
95 S IBBPV1(25)=$S(SDEVENT="DELETE CI":"",1:$P(SDNODE,U,9))
96 S IBBPV1(41)=$P($P(SDNODE,U,14),";",1)
97 I "A05,A38"[IBBEVENT
98 E S IBBPV1(44)=SDT
99 ;
100 S IBBPV2(7)=$P($P(SDNODE,U,8),";",1)
101 I "A05,A38"[IBBEVENT S IBBPV2(8)=SDT
102 S IBBPV2(24)=$P($P(SDNODE,U,3),";",1)
103 S IBBPV2(46)=$P(SDNODE,U,16)
104 ;
105 I SDEVENT="CHECK-OUT" D
106 . S SDPRV=$$ENCPRV^SDPFSS2(DFN,$G(SDVSIT))
107 . S IBBPV1(45)=$P(SDNODE,U,11)
108 I +$G(SDPRV)'>0 S SDPRV=$$DEFPRV^SDPFSS2(SDCL)
109 ;
110 I SDEVENT="DELETE CO" S IBBPV1(45)="",SDPRV=""
111 S IBBPV1(7)=$P($G(SDPRV),U,1)
112 ;
113 S IBBARFN=$S(SDEVENT="MAKE":"",1:$$GETARN^SDPFSS2(SDT,DFN,SDCL))
114B1 ; Call the Get Account API and retrieve the account number reference
115 S SDANR=$$GETACCT^IBBAPI(IBBDFN,IBBARFN,IBBEVENT,IBBAPLR,.IBBPV1,.IBBPV2)
116 ;
117 ; If this is a "Make" appt., then create a new entry in the Appointment Acct. No. Reference File
118 I SDEVENT="MAKE",+$G(SDANR)>0 D
119 . S SDOK=$$FILE(DFN,SDT,SDCL,SDANR)
120 . I 'SDOK D
121 . . S SDERRMSG=$S($P($G(SDOK),U,2)]"":$P($G(SDOK),U,2),1:"Unable to File Account Number Reference")
122 . . D ERRMSG^SDPFSS2(SDERRMSG)
123 K ^TMP($J,"SDAMA301")
124 Q
125 ;
126CHECK() ; Check routine for unit testing to allow for on/off PFSS Switch
127 N RSLT,X
128 ;
129 ; Check if the PFSS Switch Status API call is installed
130 ; If it is, then return the status of the switch, otherwise
131 ; return 0
132 I $T(SWSTAT^IBBAPI)'="" S RSLT=+$$SWSTAT^IBBAPI
133 Q +$G(RSLT)
134 ;
135FILE(DFN,SDT,SDCLN,SDANR) ; Procedure to validate and load appointment information and account number reference into file #409.55
136 ;
137 ; Input
138 ; DFN - Patient IEN in File #2
139 ; SDT - Appointment Date/Time in Fileman format
140 ; SDCLN - Clinic IEN in Hospital Location File, #44
141 ; SDANR - Account Number Reference from IBB
142 ;
143 ; Output
144 ; 1 - If entry successfully created
145 ; -1^error message - if load is unsuccessful
146 ;
147 N FDA,FDAIEN,ERR
148 ;
149 I '$G(DFN) S ERR="-1^MISSING DFN" G FILEQ
150 I '$D(^DPT(DFN)) S ERR="-1^INVALID PATIENT ENTRY" G FILEQ
151 I '$G(SDT) S ERR="-1^MISSING APPOINTMENT DATE/TIME" G FILEQ
152 I '$G(SDCLN) S ERR="-1^MISSING CLINIC LOCATION" G FILEQ
153 I '$D(^SC(SDCLN)) S ERR="-1^INVALID HOSPITAL LOCATION ENTRY" G FILEQ
154 I '$G(SDANR) S ERR="-1^No Account Number Reference provided" G FILEQ
155 ;
156 S FDA(1,409.55,"+1,",.01)=SDT
157 S FDA(1,409.55,"+1,",.02)=DFN
158 S FDA(1,409.55,"+1,",.03)=SDCLN
159 S FDA(1,409.55,"+1,",.04)=SDANR
160 D UPDATE^DIE("","FDA(1)","FDAIEN","ERR")
161 ;
162 I '$D(ERR) S ERR=1
163FILEQ Q $G(ERR)
Note: See TracBrowser for help on using the repository browser.