SDPFSS2 ;ALD/SCK - Patient Financial Services System cont. ; 22-April-2005
;;5.3;Scheduling;**430**;Aug 13, 1993
;
Q
;
GETARN(SDT,DFN,SDCL) ; Get the PFSS Account Number Reference from file #409.55 for the matching Appt. D/T,
; patient DFN, and clinic location.
; Input
; SDT - Appointment Date/Time
; DFN - Patient IEN to File #2
; SDCL - Clinic IEN to File #44
;
; Output
; If an error occurred : -1^Error message
; 0 if no match found
; SDANR if a match is found
;
N SDANR,SDIEN
;
S DFN=$G(DFN) I 'DFN S SDANR="-1^No DFN was provided" G ARNQ
S SDT=$G(SDT) I 'SDT S SDANR="-1^No Appointment Date/Time provided" G ARNQ
S SDCL=$G(SDCL) I 'SDCL S SDANR="-1^No Clinic information was provided" G ARNQ
;
S SDIEN=0
S SDIEN=$O(^SD(409.55,"D",SDT,DFN,SDCL,0))
I SDIEN>0 D
. S SDANR=$$GET1^DIQ(409.55,SDIEN,.04)
E D
. S SDANR=0
ARNQ Q $G(SDANR)
;
ENCPRV(DFN,SDVSIT) ; Returns the encounter provider associated with the visit.
; Input
; DFN - Patient IEN from the PATIENT File (#2)
; SDVSIT - Visit IEN from the VISIT File (#9000010)
; DFN and SDVSIT are references to global variables which are available as part
; of the SD application.
;
; Output
; Visit Provider from the NEW PERSON File (#200)
; IEN^Provider Name or Null
;
N PRVIEN,SDX,PRVNAME,RSLT
;
I $G(SDVSIT)>0 S SDX=$O(^AUPNVPRV("AD",SDVSIT,0))
I +$G(SDX)>0 D
. S PRVIEN=$P($G(^AUPNVPRV(SDX,0)),U)
. I PRVIEN>0,$P($G(^AUPNVPRV(SDX,0)),U,2)=DFN S PRVNAME=$$GET1^DIQ(200,PRVIEN,.01)
. S RSLT=$G(PRVIEN)_"^"_$G(PRVNAME)
Q $G(RSLT)
;
DEFPRV(SDCLN) ; Return the default provider for a clinic if one is specified
; Input
; SDCLN - Clinic IEN for HOSPITAL LOCATION File (#44)
; Output
; Provider from NEW PERSON File (#200):
; IEN^Provider Name or Null
;
N SDX,PRVIEN,PRVNAME,RSLT
;
S SDX=0
F S SDX=$O(^SC(SDCLN,"PR",SDX)) Q:'SDX D
. Q:'$P($G(^SC(SDCLN,"PR",SDX,0)),U,2)
. S PRVIEN=$P($G(^SC(SDCLN,"PR",SDX,0)),U)
. S PRVNAME=$$GET1^DIQ(200,PRVIEN,.01)
. S RSLT=$G(PRVIEN)_"^"_$G(PRVNAME)
Q $G(RSLT)
;
ERRMSG(ERRCODE) ; Generate bulletin when an error condition is processed
; Bulletins will be sent only if the receiving mail group SD RSA API ERRORS
; contains at least 1 member
;
N XMDUZ,XMSUB,XMTEXT,XMB,X,Y,MSG,SDMG,XMY
;
S SDMG=$O(^XMB(3.8,"B","SD RSA API ERRORS",0))
Q:'SDMG
; Check mail group for members. Quit if there are no members assigned to the group
Q:'$D(^XMB(3.8,SDMG,1,"B"))
;
; Get the error message, or set a generic message
S MSG=$P($G(ERRCODE),U,2)
I MSG']"" S MSG="A general error condition occurred during the PFSS Event Driver processing"
;
S XMDUZ="PFSS EVENT DRIVER"
S XMY("G.SD RSA API ERRORS")=""
S XMB="SD API ERROR NOTICE"
S XMB(1)=$$GET1^DIQ(2,DFN,.01)
S XMB(2)=$$FMTE^XLFDT(SDT)
S XMB(3)=$$GET1^DIQ(44,SDCL,.01)
S XMB(4)=IBBEVENT
S XMB(5)=MSG
D ^XMB
Q
;
GETEVT(EVT) ; Return message type for appointment event
; The following appoint events will return the indicated message type
; MAKE A05
; CHECK-IN A04
; CHECK-OUT A03
; NO-SHOW A38
;
; CANCEL APPT. A38
; CANCEL CHECK-IN A11
; CANCEL CHECK-OUT A13
; CANCEL NO-SHOW A05
;
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:"")
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDPFSS2 3525 printed Apr 09, 2024@21:47:03 Page 2
SDPFSS2 ;ALD/SCK - Patient Financial Services System cont. ; 22-April-2005
+1 ;;5.3;Scheduling;**430**;Aug 13, 1993
+2 ;
+3 QUIT
+4 ;
GETARN(SDT,DFN,SDCL) ; Get the PFSS Account Number Reference from file #409.55 for the matching Appt. D/T,
+1 ; patient DFN, and clinic location.
+2 ; Input
+3 ; SDT - Appointment Date/Time
+4 ; DFN - Patient IEN to File #2
+5 ; SDCL - Clinic IEN to File #44
+6 ;
+7 ; Output
+8 ; If an error occurred : -1^Error message
+9 ; 0 if no match found
+10 ; SDANR if a match is found
+11 ;
+12 NEW SDANR,SDIEN
+13 ;
+14 SET DFN=$GET(DFN)
IF 'DFN
SET SDANR="-1^No DFN was provided"
GOTO ARNQ
+15 SET SDT=$GET(SDT)
IF 'SDT
SET SDANR="-1^No Appointment Date/Time provided"
GOTO ARNQ
+16 SET SDCL=$GET(SDCL)
IF 'SDCL
SET SDANR="-1^No Clinic information was provided"
GOTO ARNQ
+17 ;
+18 SET SDIEN=0
+19 SET SDIEN=$ORDER(^SD(409.55,"D",SDT,DFN,SDCL,0))
+20 IF SDIEN>0
Begin DoDot:1
+21 SET SDANR=$$GET1^DIQ(409.55,SDIEN,.04)
End DoDot:1
+22 IF '$TEST
Begin DoDot:1
+23 SET SDANR=0
End DoDot:1
ARNQ QUIT $GET(SDANR)
+1 ;
ENCPRV(DFN,SDVSIT) ; Returns the encounter provider associated with the visit.
+1 ; Input
+2 ; DFN - Patient IEN from the PATIENT File (#2)
+3 ; SDVSIT - Visit IEN from the VISIT File (#9000010)
+4 ; DFN and SDVSIT are references to global variables which are available as part
+5 ; of the SD application.
+6 ;
+7 ; Output
+8 ; Visit Provider from the NEW PERSON File (#200)
+9 ; IEN^Provider Name or Null
+10 ;
+11 NEW PRVIEN,SDX,PRVNAME,RSLT
+12 ;
+13 IF $GET(SDVSIT)>0
SET SDX=$ORDER(^AUPNVPRV("AD",SDVSIT,0))
+14 IF +$GET(SDX)>0
Begin DoDot:1
+15 SET PRVIEN=$PIECE($GET(^AUPNVPRV(SDX,0)),U)
+16 IF PRVIEN>0
IF $PIECE($GET(^AUPNVPRV(SDX,0)),U,2)=DFN
SET PRVNAME=$$GET1^DIQ(200,PRVIEN,.01)
+17 SET RSLT=$GET(PRVIEN)_"^"_$GET(PRVNAME)
End DoDot:1
+18 QUIT $GET(RSLT)
+19 ;
DEFPRV(SDCLN) ; Return the default provider for a clinic if one is specified
+1 ; Input
+2 ; SDCLN - Clinic IEN for HOSPITAL LOCATION File (#44)
+3 ; Output
+4 ; Provider from NEW PERSON File (#200):
+5 ; IEN^Provider Name or Null
+6 ;
+7 NEW SDX,PRVIEN,PRVNAME,RSLT
+8 ;
+9 SET SDX=0
+10 FOR
SET SDX=$ORDER(^SC(SDCLN,"PR",SDX))
if 'SDX
QUIT
Begin DoDot:1
+11 if '$PIECE($GET(^SC(SDCLN,"PR",SDX,0)),U,2)
QUIT
+12 SET PRVIEN=$PIECE($GET(^SC(SDCLN,"PR",SDX,0)),U)
+13 SET PRVNAME=$$GET1^DIQ(200,PRVIEN,.01)
+14 SET RSLT=$GET(PRVIEN)_"^"_$GET(PRVNAME)
End DoDot:1
+15 QUIT $GET(RSLT)
+16 ;
ERRMSG(ERRCODE) ; Generate bulletin when an error condition is processed
+1 ; Bulletins will be sent only if the receiving mail group SD RSA API ERRORS
+2 ; contains at least 1 member
+3 ;
+4 NEW XMDUZ,XMSUB,XMTEXT,XMB,X,Y,MSG,SDMG,XMY
+5 ;
+6 SET SDMG=$ORDER(^XMB(3.8,"B","SD RSA API ERRORS",0))
+7 if 'SDMG
QUIT
+8 ; Check mail group for members. Quit if there are no members assigned to the group
+9 if '$DATA(^XMB(3.8,SDMG,1,"B"))
QUIT
+10 ;
+11 ; Get the error message, or set a generic message
+12 SET MSG=$PIECE($GET(ERRCODE),U,2)
+13 IF MSG']""
SET MSG="A general error condition occurred during the PFSS Event Driver processing"
+14 ;
+15 SET XMDUZ="PFSS EVENT DRIVER"
+16 SET XMY("G.SD RSA API ERRORS")=""
+17 SET XMB="SD API ERROR NOTICE"
+18 SET XMB(1)=$$GET1^DIQ(2,DFN,.01)
+19 SET XMB(2)=$$FMTE^XLFDT(SDT)
+20 SET XMB(3)=$$GET1^DIQ(44,SDCL,.01)
+21 SET XMB(4)=IBBEVENT
+22 SET XMB(5)=MSG
+23 DO ^XMB
+24 QUIT
+25 ;
GETEVT(EVT) ; Return message type for appointment event
+1 ; The following appoint events will return the indicated message type
+2 ; MAKE A05
+3 ; CHECK-IN A04
+4 ; CHECK-OUT A03
+5 ; NO-SHOW A38
+6 ;
+7 ; CANCEL APPT. A38
+8 ; CANCEL CHECK-IN A11
+9 ; CANCEL CHECK-OUT A13
+10 ; CANCEL NO-SHOW A05
+11 ;
+12 QUIT $SELECT(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:"")
