- 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 Jan 18, 2025@04:00:42 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:"")