SDPFSS ;ALB/SCK - Patient Financial Services System ;22-APR-2005
;;5.3;Scheduling;**430**;Aug 13, 1993
;
Q
;
EVENT ; Entry point for PFSS Protocol event. This procedure will manage the IBB event actions.
;
N SDEVENT,SDTEST,SDBEFORE,SDAFTER,SDMSG,SDARRAY,SDCNT,SDPRV,SDERR,SDERRMSG,SDNODE,SDOK
N IBBDFN,IBBAPLR,IBBEVENT,IBBPV1,IBBPV2,IBBARFN
;
; Check conditions before proceeding
Q:'$G(DFN)
Q:'$$CHECK
Q:$$TESTPAT^VADPT(DFN)
;
; Call the ICN API to generate an ICN if one does not exist for the patient.
S SDOK=$$ICNLC^MPIF001(DFN)
I SDOK<0 D
. D ERRMSG^SDPFSS2(SDOK)
;
; Get event type
S SDEVENT=$S($D(SDAMEVT):$$GET1^DIQ(409.66,SDAMEVT,.01),1:"OTHER")
I SDEVENT="CHECK-OUT",+$G(SDPFSFLG) S SDEVENT="DELETE CO"
;
S SDBEFORE=$P($G(SDATA("BEFORE","STATUS")),U,3)
S SDAFTER=$P($G(SDATA("AFTER","STATUS")),U,3)
;
I SDEVENT="CHECK-IN" D
. I SDBEFORE="ACT REQ/CHECKED IN"&(SDAFTER["NO ACTION TAKEN") S SDEVENT="DELETE CI"
;
I SDEVENT="NO-SHOW" D
. I SDBEFORE="NO-SHOW"&(SDAFTER["NO ACTION TAKEN") S SDEVENT="DELETE NS"
;
S IBBDFN=DFN
S IBBAPLR=""
S IBBEVENT=$$GETEVT^SDPFSS2(SDEVENT)
;
; Call the Scheduling Appointment Data API to retrieve appointment data
K ^TMP($J,"SDAMA301")
S SDARRAY(1)=$G(SDT)_";"_$G(SDT)
S SDARRAY(2)=$G(SDCL)
S SDARRAY(4)=$G(DFN)
S SDARRAY("FLDS")="1;2;3;8;9;10;11;13;14;15;16;17;18"
S SDCNT=$$SDAPI^SDAMA301(.SDARRAY)
;
; check for any errors in the TMP global
I SDCNT<0 D
. S SDERR=$O(^TMP($J,"SDAMA301",0))
. I SDERR D
. . S SDERRMSG=^TMP($J,"SDAMA301",SDERR)
. . S SDERR=SDERR_"^"_SDERRMSG
. E D
. . S SDERR="-1^Undefined error returned by SDAPI"
. D ERRMSG^SDPFSS2(SDERR)
. ; Null out the data global for further processing
. S ^TMP($J,"SDAMA301",DFN,SDCL,SDT)=""
;
I SDCNT=0 D
. S SDERR="-1^No appointments were returned by SDAPI"_"^"_DFN_"^"_SDT_"^"_SDCL
. D ERRMSG^SDPFSS2(SDERR)
;
; Build data arrays for PFSS Account API
S SDNODE=$G(^TMP($J,"SDAMA301",DFN,SDCL,SDT))
S IBBPV1(2)="O"
S IBBPV1(3)=SDCL
S IBBPV1(4)=+$P(SDNODE,U,10)
S IBBPV1(10)=+$P(SDNODE,U,18)
S IBBPV1(18)=$P($P(SDNODE,U,13),";",1)
S IBBPV1(51)=$P(SDNODE,U,15)
S IBBPV1(25)=$S(SDEVENT="DELETE CI":"",1:$P(SDNODE,U,9))
S IBBPV1(41)=$P($P(SDNODE,U,14),";",1)
I "A05,A38"[IBBEVENT
E S IBBPV1(44)=SDT
;
S IBBPV2(7)=$P($P(SDNODE,U,8),";",1)
I "A05,A38"[IBBEVENT S IBBPV2(8)=SDT
S IBBPV2(24)=$P($P(SDNODE,U,3),";",1)
S IBBPV2(46)=$P(SDNODE,U,16)
;
I SDEVENT="CHECK-OUT" D
. S SDPRV=$$ENCPRV^SDPFSS2(DFN,$G(SDVSIT))
. S IBBPV1(45)=$P(SDNODE,U,11)
I +$G(SDPRV)'>0 S SDPRV=$$DEFPRV^SDPFSS2(SDCL)
;
I SDEVENT="DELETE CO" S IBBPV1(45)="",SDPRV=""
S IBBPV1(7)=$P($G(SDPRV),U,1)
;
S IBBARFN=$S(SDEVENT="MAKE":"",1:$$GETARN^SDPFSS2(SDT,DFN,SDCL))
B1 ; Call the Get Account API and retrieve the account number reference
S SDANR=$$GETACCT^IBBAPI(IBBDFN,IBBARFN,IBBEVENT,IBBAPLR,.IBBPV1,.IBBPV2)
;
; If this is a "Make" appt., then create a new entry in the Appointment Acct. No. Reference File
I SDEVENT="MAKE",+$G(SDANR)>0 D
. S SDOK=$$FILE(DFN,SDT,SDCL,SDANR)
. I 'SDOK D
. . S SDERRMSG=$S($P($G(SDOK),U,2)]"":$P($G(SDOK),U,2),1:"Unable to File Account Number Reference")
. . D ERRMSG^SDPFSS2(SDERRMSG)
K ^TMP($J,"SDAMA301")
Q
;
CHECK() ; Check routine for unit testing to allow for on/off PFSS Switch
N RSLT,X
;
; Check if the PFSS Switch Status API call is installed
; If it is, then return the status of the switch, otherwise
; return 0
I $T(SWSTAT^IBBAPI)'="" S RSLT=+$$SWSTAT^IBBAPI
Q +$G(RSLT)
;
FILE(DFN,SDT,SDCLN,SDANR) ; Procedure to validate and load appointment information and account number reference into file #409.55
;
; Input
; DFN - Patient IEN in File #2
; SDT - Appointment Date/Time in Fileman format
; SDCLN - Clinic IEN in Hospital Location File, #44
; SDANR - Account Number Reference from IBB
;
; Output
; 1 - If entry successfully created
; -1^error message - if load is unsuccessful
;
N FDA,FDAIEN,ERR
;
I '$G(DFN) S ERR="-1^MISSING DFN" G FILEQ
I '$D(^DPT(DFN)) S ERR="-1^INVALID PATIENT ENTRY" G FILEQ
I '$G(SDT) S ERR="-1^MISSING APPOINTMENT DATE/TIME" G FILEQ
I '$G(SDCLN) S ERR="-1^MISSING CLINIC LOCATION" G FILEQ
I '$D(^SC(SDCLN)) S ERR="-1^INVALID HOSPITAL LOCATION ENTRY" G FILEQ
I '$G(SDANR) S ERR="-1^No Account Number Reference provided" G FILEQ
;
S FDA(1,409.55,"+1,",.01)=SDT
S FDA(1,409.55,"+1,",.02)=DFN
S FDA(1,409.55,"+1,",.03)=SDCLN
S FDA(1,409.55,"+1,",.04)=SDANR
D UPDATE^DIE("","FDA(1)","FDAIEN","ERR")
;
I '$D(ERR) S ERR=1
FILEQ Q $G(ERR)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDPFSS 4672 printed Sep 23, 2025@20:36:20 Page 2
SDPFSS ;ALB/SCK - Patient Financial Services System ;22-APR-2005
+1 ;;5.3;Scheduling;**430**;Aug 13, 1993
+2 ;
+3 QUIT
+4 ;
EVENT ; Entry point for PFSS Protocol event. This procedure will manage the IBB event actions.
+1 ;
+2 NEW SDEVENT,SDTEST,SDBEFORE,SDAFTER,SDMSG,SDARRAY,SDCNT,SDPRV,SDERR,SDERRMSG,SDNODE,SDOK
+3 NEW IBBDFN,IBBAPLR,IBBEVENT,IBBPV1,IBBPV2,IBBARFN
+4 ;
+5 ; Check conditions before proceeding
+6 if '$GET(DFN)
QUIT
+7 if '$$CHECK
QUIT
+8 if $$TESTPAT^VADPT(DFN)
QUIT
+9 ;
+10 ; Call the ICN API to generate an ICN if one does not exist for the patient.
+11 SET SDOK=$$ICNLC^MPIF001(DFN)
+12 IF SDOK<0
Begin DoDot:1
+13 DO ERRMSG^SDPFSS2(SDOK)
End DoDot:1
+14 ;
+15 ; Get event type
+16 SET SDEVENT=$SELECT($DATA(SDAMEVT):$$GET1^DIQ(409.66,SDAMEVT,.01),1:"OTHER")
+17 IF SDEVENT="CHECK-OUT"
IF +$GET(SDPFSFLG)
SET SDEVENT="DELETE CO"
+18 ;
+19 SET SDBEFORE=$PIECE($GET(SDATA("BEFORE","STATUS")),U,3)
+20 SET SDAFTER=$PIECE($GET(SDATA("AFTER","STATUS")),U,3)
+21 ;
+22 IF SDEVENT="CHECK-IN"
Begin DoDot:1
+23 IF SDBEFORE="ACT REQ/CHECKED IN"&(SDAFTER["NO ACTION TAKEN")
SET SDEVENT="DELETE CI"
End DoDot:1
+24 ;
+25 IF SDEVENT="NO-SHOW"
Begin DoDot:1
+26 IF SDBEFORE="NO-SHOW"&(SDAFTER["NO ACTION TAKEN")
SET SDEVENT="DELETE NS"
End DoDot:1
+27 ;
+28 SET IBBDFN=DFN
+29 SET IBBAPLR=""
+30 SET IBBEVENT=$$GETEVT^SDPFSS2(SDEVENT)
+31 ;
+32 ; Call the Scheduling Appointment Data API to retrieve appointment data
+33 KILL ^TMP($JOB,"SDAMA301")
+34 SET SDARRAY(1)=$GET(SDT)_";"_$GET(SDT)
+35 SET SDARRAY(2)=$GET(SDCL)
+36 SET SDARRAY(4)=$GET(DFN)
+37 SET SDARRAY("FLDS")="1;2;3;8;9;10;11;13;14;15;16;17;18"
+38 SET SDCNT=$$SDAPI^SDAMA301(.SDARRAY)
+39 ;
+40 ; check for any errors in the TMP global
+41 IF SDCNT<0
Begin DoDot:1
+42 SET SDERR=$ORDER(^TMP($JOB,"SDAMA301",0))
+43 IF SDERR
Begin DoDot:2
+44 SET SDERRMSG=^TMP($JOB,"SDAMA301",SDERR)
+45 SET SDERR=SDERR_"^"_SDERRMSG
End DoDot:2
+46 IF '$TEST
Begin DoDot:2
+47 SET SDERR="-1^Undefined error returned by SDAPI"
End DoDot:2
+48 DO ERRMSG^SDPFSS2(SDERR)
+49 ; Null out the data global for further processing
+50 SET ^TMP($JOB,"SDAMA301",DFN,SDCL,SDT)=""
End DoDot:1
+51 ;
+52 IF SDCNT=0
Begin DoDot:1
+53 SET SDERR="-1^No appointments were returned by SDAPI"_"^"_DFN_"^"_SDT_"^"_SDCL
+54 DO ERRMSG^SDPFSS2(SDERR)
End DoDot:1
+55 ;
+56 ; Build data arrays for PFSS Account API
+57 SET SDNODE=$GET(^TMP($JOB,"SDAMA301",DFN,SDCL,SDT))
+58 SET IBBPV1(2)="O"
+59 SET IBBPV1(3)=SDCL
+60 SET IBBPV1(4)=+$PIECE(SDNODE,U,10)
+61 SET IBBPV1(10)=+$PIECE(SDNODE,U,18)
+62 SET IBBPV1(18)=$PIECE($PIECE(SDNODE,U,13),";",1)
+63 SET IBBPV1(51)=$PIECE(SDNODE,U,15)
+64 SET IBBPV1(25)=$SELECT(SDEVENT="DELETE CI":"",1:$PIECE(SDNODE,U,9))
+65 SET IBBPV1(41)=$PIECE($PIECE(SDNODE,U,14),";",1)
+66 IF "A05,A38"[IBBEVENT
+67 IF '$TEST
SET IBBPV1(44)=SDT
+68 ;
+69 SET IBBPV2(7)=$PIECE($PIECE(SDNODE,U,8),";",1)
+70 IF "A05,A38"[IBBEVENT
SET IBBPV2(8)=SDT
+71 SET IBBPV2(24)=$PIECE($PIECE(SDNODE,U,3),";",1)
+72 SET IBBPV2(46)=$PIECE(SDNODE,U,16)
+73 ;
+74 IF SDEVENT="CHECK-OUT"
Begin DoDot:1
+75 SET SDPRV=$$ENCPRV^SDPFSS2(DFN,$GET(SDVSIT))
+76 SET IBBPV1(45)=$PIECE(SDNODE,U,11)
End DoDot:1
+77 IF +$GET(SDPRV)'>0
SET SDPRV=$$DEFPRV^SDPFSS2(SDCL)
+78 ;
+79 IF SDEVENT="DELETE CO"
SET IBBPV1(45)=""
SET SDPRV=""
+80 SET IBBPV1(7)=$PIECE($GET(SDPRV),U,1)
+81 ;
+82 SET IBBARFN=$SELECT(SDEVENT="MAKE":"",1:$$GETARN^SDPFSS2(SDT,DFN,SDCL))
B1 ; Call the Get Account API and retrieve the account number reference
+1 SET SDANR=$$GETACCT^IBBAPI(IBBDFN,IBBARFN,IBBEVENT,IBBAPLR,.IBBPV1,.IBBPV2)
+2 ;
+3 ; If this is a "Make" appt., then create a new entry in the Appointment Acct. No. Reference File
+4 IF SDEVENT="MAKE"
IF +$GET(SDANR)>0
Begin DoDot:1
+5 SET SDOK=$$FILE(DFN,SDT,SDCL,SDANR)
+6 IF 'SDOK
Begin DoDot:2
+7 SET SDERRMSG=$SELECT($PIECE($GET(SDOK),U,2)]"":$PIECE($GET(SDOK),U,2),1:"Unable to File Account Number Reference")
+8 DO ERRMSG^SDPFSS2(SDERRMSG)
End DoDot:2
End DoDot:1
+9 KILL ^TMP($JOB,"SDAMA301")
+10 QUIT
+11 ;
CHECK() ; Check routine for unit testing to allow for on/off PFSS Switch
+1 NEW RSLT,X
+2 ;
+3 ; Check if the PFSS Switch Status API call is installed
+4 ; If it is, then return the status of the switch, otherwise
+5 ; return 0
+6 IF $TEXT(SWSTAT^IBBAPI)'=""
SET RSLT=+$$SWSTAT^IBBAPI
+7 QUIT +$GET(RSLT)
+8 ;
FILE(DFN,SDT,SDCLN,SDANR) ; Procedure to validate and load appointment information and account number reference into file #409.55
+1 ;
+2 ; Input
+3 ; DFN - Patient IEN in File #2
+4 ; SDT - Appointment Date/Time in Fileman format
+5 ; SDCLN - Clinic IEN in Hospital Location File, #44
+6 ; SDANR - Account Number Reference from IBB
+7 ;
+8 ; Output
+9 ; 1 - If entry successfully created
+10 ; -1^error message - if load is unsuccessful
+11 ;
+12 NEW FDA,FDAIEN,ERR
+13 ;
+14 IF '$GET(DFN)
SET ERR="-1^MISSING DFN"
GOTO FILEQ
+15 IF '$DATA(^DPT(DFN))
SET ERR="-1^INVALID PATIENT ENTRY"
GOTO FILEQ
+16 IF '$GET(SDT)
SET ERR="-1^MISSING APPOINTMENT DATE/TIME"
GOTO FILEQ
+17 IF '$GET(SDCLN)
SET ERR="-1^MISSING CLINIC LOCATION"
GOTO FILEQ
+18 IF '$DATA(^SC(SDCLN))
SET ERR="-1^INVALID HOSPITAL LOCATION ENTRY"
GOTO FILEQ
+19 IF '$GET(SDANR)
SET ERR="-1^No Account Number Reference provided"
GOTO FILEQ
+20 ;
+21 SET FDA(1,409.55,"+1,",.01)=SDT
+22 SET FDA(1,409.55,"+1,",.02)=DFN
+23 SET FDA(1,409.55,"+1,",.03)=SDCLN
+24 SET FDA(1,409.55,"+1,",.04)=SDANR
+25 DO UPDATE^DIE("","FDA(1)","FDAIEN","ERR")
+26 ;
+27 IF '$DATA(ERR)
SET ERR=1
FILEQ QUIT $GET(ERR)
