source: FOIAVistA/tag/r/SCHEDULING-SD-SC/SDPFSS2.m@ 1700

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

initial load of FOIAVistA 6/30/08 version

File size: 3.3 KB
Line 
1SDPFSS2 ;ALD/SCK - Patient Financial Services System cont. ; 22-April-2005
2 ;;5.3;Scheduling;**430**;Aug 13, 1993
3 ;
4 Q
5 ;
6GETARN(SDT,DFN,SDCL) ; Get the PFSS Account Number Reference from file #409.55 for the matching Appt. D/T,
7 ; patient DFN, and clinic location.
8 ; Input
9 ; SDT - Appointment Date/Time
10 ; DFN - Patient IEN to File #2
11 ; SDCL - Clinic IEN to File #44
12 ;
13 ; Output
14 ; If an error occurred : -1^Error message
15 ; 0 if no match found
16 ; SDANR if a match is found
17 ;
18 N SDANR,SDIEN
19 ;
20 S DFN=$G(DFN) I 'DFN S SDANR="-1^No DFN was provided" G ARNQ
21 S SDT=$G(SDT) I 'SDT S SDANR="-1^No Appointment Date/Time provided" G ARNQ
22 S SDCL=$G(SDCL) I 'SDCL S SDANR="-1^No Clinic information was provided" G ARNQ
23 ;
24 S SDIEN=0
25 S SDIEN=$O(^SD(409.55,"D",SDT,DFN,SDCL,0))
26 I SDIEN>0 D
27 . S SDANR=$$GET1^DIQ(409.55,SDIEN,.04)
28 E D
29 . S SDANR=0
30ARNQ Q $G(SDANR)
31 ;
32ENCPRV(DFN,SDVSIT) ; Returns the encounter provider associated with the visit.
33 ; Input
34 ; DFN - Patient IEN from the PATIENT File (#2)
35 ; SDVSIT - Visit IEN from the VISIT File (#9000010)
36 ; DFN and SDVSIT are references to global variables which are available as part
37 ; of the SD application.
38 ;
39 ; Output
40 ; Visit Provider from the NEW PERSON File (#200)
41 ; IEN^Provider Name or Null
42 ;
43 N PRVIEN,SDX,PRVNAME,RSLT
44 ;
45 I $G(SDVSIT)>0 S SDX=$O(^AUPNVPRV("AD",SDVSIT,0))
46 I +$G(SDX)>0 D
47 . S PRVIEN=$P($G(^AUPNVPRV(SDX,0)),U)
48 . I PRVIEN>0,$P($G(^AUPNVPRV(SDX,0)),U,2)=DFN S PRVNAME=$$GET1^DIQ(200,PRVIEN,.01)
49 . S RSLT=$G(PRVIEN)_"^"_$G(PRVNAME)
50 Q $G(RSLT)
51 ;
52DEFPRV(SDCLN) ; Return the default provider for a clinic if one is specified
53 ; Input
54 ; SDCLN - Clinic IEN for HOSPITAL LOCATION File (#44)
55 ; Output
56 ; Provider from NEW PERSON File (#200):
57 ; IEN^Provider Name or Null
58 ;
59 N SDX,PRVIEN,PRVNAME,RSLT
60 ;
61 S SDX=0
62 F S SDX=$O(^SC(SDCLN,"PR",SDX)) Q:'SDX D
63 . Q:'$P($G(^SC(SDCLN,"PR",SDX,0)),U,2)
64 . S PRVIEN=$P($G(^SC(SDCLN,"PR",SDX,0)),U)
65 . S PRVNAME=$$GET1^DIQ(200,PRVIEN,.01)
66 . S RSLT=$G(PRVIEN)_"^"_$G(PRVNAME)
67 Q $G(RSLT)
68 ;
69ERRMSG(ERRCODE) ; Generate bulletin when an error condition is processed
70 ; Bulletins will be sent only if the receiving mail group SD RSA API ERRORS
71 ; contains at least 1 member
72 ;
73 N XMDUZ,XMSUB,XMTEXT,XMB,X,Y,MSG,SDMG,XMY
74 ;
75 S SDMG=$O(^XMB(3.8,"B","SD RSA API ERRORS",0))
76 Q:'SDMG
77 ; Check mail group for members. Quit if there are no members assigned to the group
78 Q:'$D(^XMB(3.8,SDMG,1,"B"))
79 ;
80 ; Get the error message, or set a generic message
81 S MSG=$P($G(ERRCODE),U,2)
82 I MSG']"" S MSG="A general error condition occurred during the PFSS Event Driver processing"
83 ;
84 S XMDUZ="PFSS EVENT DRIVER"
85 S XMY("G.SD RSA API ERRORS")=""
86 S XMB="SD API ERROR NOTICE"
87 S XMB(1)=$$GET1^DIQ(2,DFN,.01)
88 S XMB(2)=$$FMTE^XLFDT(SDT)
89 S XMB(3)=$$GET1^DIQ(44,SDCL,.01)
90 S XMB(4)=IBBEVENT
91 S XMB(5)=MSG
92 D ^XMB
93 Q
94 ;
95GETEVT(EVT) ; Return message type for appointment event
96 ; The following appoint events will return the indicated message type
97 ; MAKE A05
98 ; CHECK-IN A04
99 ; CHECK-OUT A03
100 ; NO-SHOW A38
101 ;
102 ; CANCEL APPT. A38
103 ; CANCEL CHECK-IN A11
104 ; CANCEL CHECK-OUT A13
105 ; CANCEL NO-SHOW A05
106 ;
107 Q $S(EVT="MAKE":"A05",EVT="CHECK-IN":"A04",EVT="CHECK-OUT":"A03",EVT="NO-SHOW":"A38",EVT="CANCEL":"A38",EVT="DELETE CO":"A13",EVT="DELETE CI":"A11",EVT="DELETE NS":"A05",1:"")
Note: See TracBrowser for help on using the repository browser.