source: FOIAVistA/trunk/r/SCHEDULING-SD-SC/SDPFSS.m@ 1154

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

initial load of FOIAVistA 6/30/08 version
File size: 4.4 KB
Line 
1SDPFSS ;ALB/SCK - Patient Financial Services System ;22-APR-2005
2 ;;5.3;Scheduling;**430**;Aug 13, 1993
3 ;
4 Q
5 ;
6EVENT ; Entry point for PFSS Protocol event. This procedure will manage the IBB event actions.
7 ;
8 N SDEVENT,SDTEST,SDBEFORE,SDAFTER,SDMSG,SDARRAY,SDCNT,SDPRV,SDERR,SDERRMSG,SDNODE,SDOK
9 N IBBDFN,IBBAPLR,IBBEVENT,IBBPV1,IBBPV2,IBBARFN
10 ;
11 ; Check conditions before proceeding
12 Q:'$G(DFN)
13 Q:'$$CHECK
14 Q:$$TESTPAT^VADPT(DFN)
15 ;
16 ; Call the ICN API to generate an ICN if one does not exist for the patient.
17 S SDOK=$$ICNLC^MPIF001(DFN)
18 I SDOK<0 D
19 . D ERRMSG^SDPFSS2(SDOK)
20 ;
21 ; Get event type
22 S SDEVENT=$S($D(SDAMEVT):$$GET1^DIQ(409.66,SDAMEVT,.01),1:"OTHER")
23 I SDEVENT="CHECK-OUT",+$G(SDPFSFLG) S SDEVENT="DELETE CO"
24 ;
25 S SDBEFORE=$P($G(SDATA("BEFORE","STATUS")),U,3)
26 S SDAFTER=$P($G(SDATA("AFTER","STATUS")),U,3)
27 ;
28 I SDEVENT="CHECK-IN" D
29 . I SDBEFORE="ACT REQ/CHECKED IN"&(SDAFTER["NO ACTION TAKEN") S SDEVENT="DELETE CI"
30 ;
31 I SDEVENT="NO-SHOW" D
32 . I SDBEFORE="NO-SHOW"&(SDAFTER["NO ACTION TAKEN") S SDEVENT="DELETE NS"
33 ;
34 S IBBDFN=DFN
35 S IBBAPLR=""
36 S IBBEVENT=$$GETEVT^SDPFSS2(SDEVENT)
37 ;
38 ; Call the Scheduling Appointment Data API to retrieve appointment data
39 K ^TMP($J,"SDAMA301")
40 S SDARRAY(1)=$G(SDT)_";"_$G(SDT)
41 S SDARRAY(2)=$G(SDCL)
42 S SDARRAY(4)=$G(DFN)
43 S SDARRAY("FLDS")="1;2;3;8;9;10;11;13;14;15;16;17;18"
44 S SDCNT=$$SDAPI^SDAMA301(.SDARRAY)
45 ;
46 ; check for any errors in the TMP global
47 I SDCNT<0 D
48 . S SDERR=$O(^TMP($J,"SDAMA301",0))
49 . I SDERR D
50 . . S SDERRMSG=^TMP($J,"SDAMA301",SDERR)
51 . . S SDERR=SDERR_"^"_SDERRMSG
52 . E D
53 . . S SDERR="-1^Undefined error returned by SDAPI"
54 . D ERRMSG^SDPFSS2(SDERR)
55 . ; Null out the data global for further processing
56 . S ^TMP($J,"SDAMA301",DFN,SDCL,SDT)=""
57 ;
58 I SDCNT=0 D
59 . S SDERR="-1^No appointments were returned by SDAPI"_"^"_DFN_"^"_SDT_"^"_SDCL
60 . D ERRMSG^SDPFSS2(SDERR)
61 ;
62 ; Build data arrays for PFSS Account API
63 S SDNODE=$G(^TMP($J,"SDAMA301",DFN,SDCL,SDT))
64 S IBBPV1(2)="O"
65 S IBBPV1(3)=SDCL
66 S IBBPV1(4)=+$P(SDNODE,U,10)
67 S IBBPV1(10)=+$P(SDNODE,U,18)
68 S IBBPV1(18)=$P($P(SDNODE,U,13),";",1)
69 S IBBPV1(51)=$P(SDNODE,U,15)
70 S IBBPV1(25)=$S(SDEVENT="DELETE CI":"",1:$P(SDNODE,U,9))
71 S IBBPV1(41)=$P($P(SDNODE,U,14),";",1)
72 I "A05,A38"[IBBEVENT
73 E S IBBPV1(44)=SDT
74 ;
75 S IBBPV2(7)=$P($P(SDNODE,U,8),";",1)
76 I "A05,A38"[IBBEVENT S IBBPV2(8)=SDT
77 S IBBPV2(24)=$P($P(SDNODE,U,3),";",1)
78 S IBBPV2(46)=$P(SDNODE,U,16)
79 ;
80 I SDEVENT="CHECK-OUT" D
81 . S SDPRV=$$ENCPRV^SDPFSS2(DFN,$G(SDVSIT))
82 . S IBBPV1(45)=$P(SDNODE,U,11)
83 I +$G(SDPRV)'>0 S SDPRV=$$DEFPRV^SDPFSS2(SDCL)
84 ;
85 I SDEVENT="DELETE CO" S IBBPV1(45)="",SDPRV=""
86 S IBBPV1(7)=$P($G(SDPRV),U,1)
87 ;
88 S IBBARFN=$S(SDEVENT="MAKE":"",1:$$GETARN^SDPFSS2(SDT,DFN,SDCL))
89B1 ; Call the Get Account API and retrieve the account number reference
90 S SDANR=$$GETACCT^IBBAPI(IBBDFN,IBBARFN,IBBEVENT,IBBAPLR,.IBBPV1,.IBBPV2)
91 ;
92 ; If this is a "Make" appt., then create a new entry in the Appointment Acct. No. Reference File
93 I SDEVENT="MAKE",+$G(SDANR)>0 D
94 . S SDOK=$$FILE(DFN,SDT,SDCL,SDANR)
95 . I 'SDOK D
96 . . S SDERRMSG=$S($P($G(SDOK),U,2)]"":$P($G(SDOK),U,2),1:"Unable to File Account Number Reference")
97 . . D ERRMSG^SDPFSS2(SDERRMSG)
98 K ^TMP($J,"SDAMA301")
99 Q
100 ;
101CHECK() ; Check routine for unit testing to allow for on/off PFSS Switch
102 N RSLT,X
103 ;
104 ; Check if the PFSS Switch Status API call is installed
105 ; If it is, then return the status of the switch, otherwise
106 ; return 0
107 I $T(SWSTAT^IBBAPI)'="" S RSLT=+$$SWSTAT^IBBAPI
108 Q +$G(RSLT)
109 ;
110FILE(DFN,SDT,SDCLN,SDANR) ; Procedure to validate and load appointment information and account number reference into file #409.55
111 ;
112 ; Input
113 ; DFN - Patient IEN in File #2
114 ; SDT - Appointment Date/Time in Fileman format
115 ; SDCLN - Clinic IEN in Hospital Location File, #44
116 ; SDANR - Account Number Reference from IBB
117 ;
118 ; Output
119 ; 1 - If entry successfully created
120 ; -1^error message - if load is unsuccessful
121 ;
122 N FDA,FDAIEN,ERR
123 ;
124 I '$G(DFN) S ERR="-1^MISSING DFN" G FILEQ
125 I '$D(^DPT(DFN)) S ERR="-1^INVALID PATIENT ENTRY" G FILEQ
126 I '$G(SDT) S ERR="-1^MISSING APPOINTMENT DATE/TIME" G FILEQ
127 I '$G(SDCLN) S ERR="-1^MISSING CLINIC LOCATION" G FILEQ
128 I '$D(^SC(SDCLN)) S ERR="-1^INVALID HOSPITAL LOCATION ENTRY" G FILEQ
129 I '$G(SDANR) S ERR="-1^No Account Number Reference provided" G FILEQ
130 ;
131 S FDA(1,409.55,"+1,",.01)=SDT
132 S FDA(1,409.55,"+1,",.02)=DFN
133 S FDA(1,409.55,"+1,",.03)=SDCLN
134 S FDA(1,409.55,"+1,",.04)=SDANR
135 D UPDATE^DIE("","FDA(1)","FDAIEN","ERR")
136 ;
137 I '$D(ERR) S ERR=1
138FILEQ Q $G(ERR)
Note: See TracBrowser for help on using the repository browser.