Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: SDPFSS

SDPFSS.m

Go to the documentation of this file. 
  1. SDPFSS ;ALB/SCK - Patient Financial Services System  ;22-APR-2005
  1.  ;;5.3;Scheduling;**430,1015**;Aug 13, 1993;Build 21
  1.  ;
  1.  Q
  1.  ;
  1. EVENT ; Entry point for PFSS Protocol event.  This procedure will manage the IBB event actions.
  1.  ;
  1.  N SDEVENT,SDTEST,SDBEFORE,SDAFTER,SDMSG,SDARRAY,SDCNT,SDPRV,SDERR,SDERRMSG,SDNODE,SDOK
  1.  N IBBDFN,IBBAPLR,IBBEVENT,IBBPV1,IBBPV2,IBBARFN
  1.  ;
  1.  ; Check conditions before proceeding
  1.  Q:'$G(DFN)
  1.  Q:'$$CHECK
  1.  Q:$$TESTPAT^VADPT(DFN)
  1.  ;
  1.  ; Call the ICN API to generate an ICN if one does not exist for the patient.
  1.  S SDOK=$$ICNLC^MPIF001(DFN)
  1.  I SDOK<0 D
  1.  . D ERRMSG^SDPFSS2(SDOK)
  1.  ;
  1.  ; Get event type
  1.  S SDEVENT=$S($D(SDAMEVT):$$GET1^DIQ(409.66,SDAMEVT,.01),1:"OTHER")
  1.  I SDEVENT="CHECK-OUT",+$G(SDPFSFLG) S SDEVENT="DELETE CO"
  1.  ;
  1.  S SDBEFORE=$P($G(SDATA("BEFORE","STATUS")),U,3)
  1.  S SDAFTER=$P($G(SDATA("AFTER","STATUS")),U,3)
  1.  ;
  1.  I SDEVENT="CHECK-IN" D
  1.  . I SDBEFORE="ACT REQ/CHECKED IN"&(SDAFTER["NO ACTION TAKEN") S SDEVENT="DELETE CI"
  1.  ;
  1.  I SDEVENT="NO-SHOW" D
  1.  . I SDBEFORE="NO-SHOW"&(SDAFTER["NO ACTION TAKEN") S SDEVENT="DELETE NS"
  1.  ;
  1.  S IBBDFN=DFN
  1.  S IBBAPLR=""
  1.  S IBBEVENT=$$GETEVT^SDPFSS2(SDEVENT)
  1.  ;
  1.  ; Call the Scheduling Appointment Data API to retrieve appointment data
  1.  K ^TMP($J,"SDAMA301")
  1.  S SDARRAY(1)=$G(SDT)_";"_$G(SDT)
  1.  S SDARRAY(2)=$G(SDCL)
  1.  S SDARRAY(4)=$G(DFN)
  1.  S SDARRAY("FLDS")="1;2;3;8;9;10;11;13;14;15;16;17;18"
  1.  S SDCNT=$$SDAPI^SDAMA301(.SDARRAY)
  1.  ;
  1.  ; check for any errors in the TMP global
  1.  I SDCNT<0 D
  1.  . S SDERR=$O(^TMP($J,"SDAMA301",0))
  1.  . I SDERR D
  1.  . . S SDERRMSG=^TMP($J,"SDAMA301",SDERR)
  1.  . . S SDERR=SDERR_"^"_SDERRMSG
  1.  . E  D
  1.  . . S SDERR="-1^Undefined error returned by SDAPI"
  1.  . D ERRMSG^SDPFSS2(SDERR)
  1.  . ; Null out the data global for further processing
  1.  . S ^TMP($J,"SDAMA301",DFN,SDCL,SDT)=""
  1.  ;
  1.  I SDCNT=0 D
  1.  . S SDERR="-1^No appointments were returned by SDAPI"_"^"_DFN_"^"_SDT_"^"_SDCL
  1.  . D ERRMSG^SDPFSS2(SDERR)
  1.  ;
  1.  ; Build data arrays for PFSS Account API
  1.  S SDNODE=$G(^TMP($J,"SDAMA301",DFN,SDCL,SDT))
  1.  S IBBPV1(2)="O"
  1.  S IBBPV1(3)=SDCL
  1.  S IBBPV1(4)=+$P(SDNODE,U,10)
  1.  S IBBPV1(10)=+$P(SDNODE,U,18)
  1.  S IBBPV1(18)=$P($P(SDNODE,U,13),";",1)
  1.  S IBBPV1(51)=$P(SDNODE,U,15)
  1.  S IBBPV1(25)=$S(SDEVENT="DELETE CI":"",1:$P(SDNODE,U,9))
  1.  S IBBPV1(41)=$P($P(SDNODE,U,14),";",1)
  1.  I "A05,A38"[IBBEVENT
  1.  E  S IBBPV1(44)=SDT
  1.  ;
  1.  S IBBPV2(7)=$P($P(SDNODE,U,8),";",1)
  1.  I "A05,A38"[IBBEVENT S IBBPV2(8)=SDT
  1.  S IBBPV2(24)=$P($P(SDNODE,U,3),";",1)
  1.  S IBBPV2(46)=$P(SDNODE,U,16)
  1.  ;
  1.  I SDEVENT="CHECK-OUT" D
  1.  . S SDPRV=$$ENCPRV^SDPFSS2(DFN,$G(SDVSIT))
  1.  . S IBBPV1(45)=$P(SDNODE,U,11)
  1.  I +$G(SDPRV)'>0 S SDPRV=$$DEFPRV^SDPFSS2(SDCL)
  1.  ;
  1.  I SDEVENT="DELETE CO" S IBBPV1(45)="",SDPRV=""
  1.  S IBBPV1(7)=$P($G(SDPRV),U,1)
  1.  ;
  1.  S IBBARFN=$S(SDEVENT="MAKE":"",1:$$GETARN^SDPFSS2(SDT,DFN,SDCL))
  1. B1 ; Call the Get Account API and retrieve the account number reference
  1.  S SDANR=$$GETACCT^IBBAPI(IBBDFN,IBBARFN,IBBEVENT,IBBAPLR,.IBBPV1,.IBBPV2)
  1.  ;
  1.  ;  If this is a "Make" appt., then create a new entry in the Appointment Acct. No. Reference File
  1.  I SDEVENT="MAKE",+$G(SDANR)>0 D
  1.  . S SDOK=$$FILE(DFN,SDT,SDCL,SDANR)
  1.  . I 'SDOK D
  1.  . . S SDERRMSG=$S($P($G(SDOK),U,2)]"":$P($G(SDOK),U,2),1:"Unable to File Account Number Reference")
  1.  . . D ERRMSG^SDPFSS2(SDERRMSG)
  1.  K ^TMP($J,"SDAMA301")
  1.  Q
  1.  ;
  1. CHECK() ; Check routine for unit testing to allow for on/off PFSS Switch
  1.  N RSLT,X
  1.  ;
  1.  ; Check if the PFSS Switch Status API call is installed
  1.  ; If it is, then return the status of the switch, otherwise
  1.  ; return 0
  1.  I $T(SWSTAT^IBBAPI)'="" S RSLT=+$$SWSTAT^IBBAPI
  1.  Q +$G(RSLT)
  1.  ;
  1. FILE(DFN,SDT,SDCLN,SDANR) ;  Procedure to validate and load appointment information and account number reference into file #409.55
  1.  ;
  1.  ; Input
  1.  ;    DFN    - Patient IEN in File #2
  1.  ;    SDT    - Appointment Date/Time in Fileman format
  1.  ;    SDCLN  - Clinic IEN in Hospital Location File, #44
  1.  ;    SDANR  - Account Number Reference from IBB
  1.  ;
  1.  ; Output
  1.  ;    1 - If entry successfully created
  1.  ;   -1^error message - if load is unsuccessful
  1.  ;
  1.  N FDA,FDAIEN,ERR
  1.  ;
  1.  I '$G(DFN) S ERR="-1^MISSING DFN" G FILEQ
  1.  I '$D(^DPT(DFN)) S ERR="-1^INVALID PATIENT ENTRY" G FILEQ
  1.  I '$G(SDT) S ERR="-1^MISSING APPOINTMENT DATE/TIME" G FILEQ
  1.  I '$G(SDCLN) S ERR="-1^MISSING CLINIC LOCATION" G FILEQ
  1.  I '$D(^SC(SDCLN)) S ERR="-1^INVALID HOSPITAL LOCATION ENTRY" G FILEQ
  1.  I '$G(SDANR) S ERR="-1^No Account Number Reference provided" G FILEQ
  1.  ;
  1.  S FDA(1,409.55,"+1,",.01)=SDT
  1.  S FDA(1,409.55,"+1,",.02)=DFN
  1.  S FDA(1,409.55,"+1,",.03)=SDCLN
  1.  S FDA(1,409.55,"+1,",.04)=SDANR
  1.  D UPDATE^DIE("","FDA(1)","FDAIEN","ERR")
  1.  ;
  1.  I '$D(ERR) S ERR=1
  1. FILEQ Q $G(ERR)