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

SDEC31.m

Go to the documentation of this file.
SDEC31 ;ALB/SAT,PC - VISTA SCHEDULING RPCS ;Jul 23, 2021@15:22
 ;;5.3;Scheduling;**627,683,717,740,694,792,794**;Aug 13, 1993;Build 2
 ;
 Q
 ;
NOSHOW(SDECY,SDECAPTID,SDECNS,USERIEN,SDECDATE)  ;Sets appointment noshow flag in SDEC APPOINTMENT file
 ;NOSHOW(SDECY,SDECAPTID,SDECNS,USERIEN,SDECDATE)  external parameter tag is in SDEC
 ;Called by SDEC NOSHOW
 ;SDECAPTID - (required) Appointment ID - Pointer to SDEC APPOINTMENT file
 ;SDECNS    - (required) Cancel flag  1=YES (Set NOSHOW); 0=NO (Cancel NOSHOW)
 ;USERIEN   - (optional) User that entered NoShow pointer to NEW PERSON
 ;                       default to current user
 ;SDECDATE  - (optional) Date/Time that No-show was entered in external format
 ;                      default to NOW.
 ;Calls CANCEL^SDEC08 to set noshow data in ^DPT  <<== NOT TRUE wtc 10/25/18
 ;Returns error code in recordset field ERRORID
 ;
 N SDECNOD,DFN,SDECSTART,SDECID,SDECI,SDECZ,SDECERR,SDECMSG,SDFDA,SDECIENS,REQTYPE,CONS,CONSULTIEN,PROVIDER,NOTE,DATETIME,RESOURCE,REQSET
 N SDECNOEV,%DT,X,Y,SDECOE
 S SDECNOEV=1 ;Don't execute protocol
 ;
 S SDECI=0
 K ^TMP("SDEC",$J)
 S SDECY="^TMP(""SDEC"","_$J_")"
 S ^TMP("SDEC",$J,SDECI)="I00020ERRORID^T00030ERRORTEXT"_$C(30)
 S SDECI=SDECI+1
 ;validate SDEC appointment ID
 I '+SDECAPTID D ERR(0,"SDEC31: Invalid Appointment ID") Q
 I '$D(^SDEC(409.84,SDECAPTID,0)) D ERR(0,"SDEC31: Invalid Appointment ID") Q
 ;validate cancel flag
 S SDECNS=$G(SDECNS)
 S SDECNS=$S(SDECNS="YES":1,SDECNS=1:1,SDECNS="NO":0,SDECNS=0:0,1:"")
 I SDECNS="" D ERR(0,"SDEC31: Invalid No Show value") Q
 ;validate user IEN (optional)
 S USERIEN=$G(USERIEN)
 I USERIEN'="" I '$D(^VA(200,+USERIEN,0)) S USERIEN=""
 I USERIEN="" S USERIEN=DUZ
 ;validate cancel date/time (optional)
 ;
 ;  Change date/time conversion so midnight is handled properly.  wtc 694 5/17/18
 ;
 ;S %DT="" S X=$P(SDBEG,"@",1) D ^%DT S SDBEG=Y
 S SDECDATE=$G(SDECDATE)
 ;I SDECDATE'="" S %DT="T" S X=SDECDATE D ^%DT S SDECDATE=Y I Y=-1 S SDECDATE=""
 I SDECDATE'="" S SDECDATE=$$NETTOFM^SDECDATE(SDECDATE,"Y","Y") I SDECDATE=-1 S SDECDATE="" ;
 I $G(SDECDATE)="" S SDECDATE=$$NOW^XLFDT
 ;
 ;Edit SDEC APPOINTMENT entry NOSHOW field
 S SDECNOD=^SDEC(409.84,SDECAPTID,0)
 ;I SDECNOD="" D ERR(0,"SDEC31: Invalid Appointment ID") Q
 S DFN=$P(SDECNOD,U,5)
 S SDECSTART=$P(SDECNOD,U)
 ;
 ;  Event driver "BEFORE" actions - wtc SD*5.3*717 10/25/18
 ;
 N SDATA,SDDA,SDCIHDL,SDECR1,SDECSC1
 S SDECR1=$P(SDECNOD,U,7) ;RESOURCEID
 I SDECR1="" D ERR(0,"SDEC31: Missing resource") Q
 S SDECNOD=$G(^SDEC(409.831,SDECR1,0)) I SDECNOD="" D ERR(0,"SDEC31: Resource node missing") Q
 S SDECSC1=$P(SDECNOD,U,4) ;HOSPITAL LOCATION
 I SDECSC1=""  D ERR(0,"SDEC31: No location for resource") Q
 I '$D(^SC(SDECSC1,0)) D ERR(0,"SDEC31: Location node missing") Q
 ;
 S SDDA=$$FIND^SDEC25(DFN,SDECSTART,SDECSC1),SDATA=SDDA_U_DFN_U_SDECSTART_U_SDECSC1,SDCIHDL=$$HANDLE^SDAMEVT(1)
 D BEFORE^SDAMEVT(.SDATA,DFN,SDECSTART,SDECSC1,SDDA,SDCIHDL)
 ;
 ;  Process no show
 ;
 D SDECNOS(SDECAPTID,SDECNS,USERIEN,SDECDATE)
 I $D(SDECMSG("DIERR")) S SDECMSG=$G(SDECMSG("DIERR",1,"TEXT",1)) D ERR(0,"SDEC31: "_SDECMSG) Q 
 D APNOSHO(.SDECZ,SDECSC1,DFN,SDECSTART,SDECNS,USERIEN,SDECDATE,SDECAPTID)
 I +$G(SDECZ) S SDECERR="SDEC31: APNOSHO Returned: "_SDECZ D ERR(0,SDECERR) Q
 ;
 ;*zeb+2 683 2/6/18 fix action required in PCE after no-show from GUI
 S SDECOE=$P($G(^DPT(DFN,"S",SDECSTART,0)),"^",20)
 I SDECOE D EN^SDCODEL(SDECOE,2,"","NOSHOW")  ;*zeb 717 11/13/18 suppress event logging for cancel checkout when no-showing
 ;
 ;  Event driver "AFTER" actions - wtc SD*5.3*717 10/24/18
 ;
  ;remove undo no-show from grid; /BLB/
 ;
 S REQTYPE=$$GET1^DIQ(409.84,SDECAPTID,.22,"E")
 I SDECNS=0,REQTYPE="CONSULT" D
 .S CONS=$$GET1^DIQ(409.84,SDECAPTID,.22,"I"),CONSULTIEN=$P(CONS,";",1)
 .S PROVIDER=$$GET1^DIQ(409.84,SDECAPTID,.16,"I")
 .S NOTE=$$GET1^DIQ(409.84,SDECAPTID,1,"E")
 .S DATETIME=$$GET1^DIQ(409.84,SDECAPTID,.01,"E")
 .S RESOURCE=$$GET1^DIQ(409.84,SDECAPTID,.07,"I")
 .D REQSET^SDEC07A(CONSULTIEN,PROVIDER,,1,,NOTE,DATETIME,RESOURCE)
 ;
 D AFTER^SDAMEVT(.SDATA,DFN,SDECSTART,SDECSC1,SDDA,SDCIHDL)
 ;
 ;  Execute event driver.  3=no show (see #409.66), 2=non-interactive - wtc SD*5.3*717 10/25/18
 ;
 D EVT^SDAMEVT(.SDATA,3,2,SDCIHDL) ;
 ;
 S SDECI=SDECI+1
 S ^TMP("SDEC",$J,SDECI)="1^"_$C(30)
 S SDECI=SDECI+1
 S ^TMP("SDEC",$J,SDECI)=$C(31)
 Q
 ;
APNOSHO(SDECZ,SDCL,DFN,SDT,SDECNS,USERIEN,SDECCDT,SDAPID)  ;
 ; update file 2 info
 ;Set noshow for patient DFN in clinic SDCL
 ;at time SDT
 N SDECC,%H,SDECIEN,SDRTYP
 N SDECIENS,SDFDA,SDECMSG,IEN
 S %H=$H D YMD^%DTC
 ;
 S SDECIENS=SDT_","_DFN_","
 I +SDECNS D
 . S SDFDA(2.98,SDECIENS,3)="N"
 . S SDFDA(2.98,SDECIENS,14)=USERIEN
 . S SDFDA(2.98,SDECIENS,15)=SDECCDT
 E  D
 . S SDFDA(2.98,SDECIENS,3)=""
 . S SDFDA(2.98,SDECIENS,14)=""
 . S SDFDA(2.98,SDECIENS,15)=""
 K SDECIEN
 D UPDATE^DIE("","SDFDA","SDECIEN","SDECMSG")
 S SDECZ=$G(SDECMSG("DIERR",1,"TEXT",1))
 S SDRTYP=$$GET1^DIQ(409.84,SDAPID_",",.22,"I")
 I $P(SDRTYP,";",2)="GMR(123," D
 .S IEN=$$SCIEN^SDECU2(DFN,SDCL,SDT)
 .D NOSHOW^SDCNSLT(SDCL,SDT,DFN,$P(SDRTYP,";",1),IEN)     ;,AUTO,NSDIE,NSDA)
 ;
 ;for Recall Request APPT NOSHOW ;VSE-1219;**792
 I $P(SDRTYP,";",2)="SD(403.5," D RECREQ^SDECRECREQ(.SDECY,SDECAPTID,SDRTYP)
 Q
 ;
SDECNOS(SDECAPTID,SDECNS,USERIEN,SDECDATE) ;
 ;
 N SDFDA,SDECIENS
 S SDECIENS=SDECAPTID_","
 S SDFDA(409.84,SDECIENS,.1)=SDECNS ;NOSHOW
 S SDFDA(409.84,SDECIENS,.101)=$S(+SDECNS:SDECDATE,1:"")  ;NOSHOW DATE
 S SDFDA(409.84,SDECIENS,.102)=$S(+SDECNS:USERIEN,1:"")   ;NOSHOW USER
 S SDFDA(409.84,SDECIENS,.17)=$S(+SDECNS:"N",1:"") ;  Update STATUS SD*5.3*717 wtc 10/25/18
 D FILE^DIE("","SDFDA","SDECMSG")
 ;
 Q
 ;
NOSEVT(SDECPAT,SDECSTART,SDECSC) ;EP Called by SDEC NOSHOW APPOINTMENT event
 ;when appointments NOSHOW via PIMS interface.
 ;Propagates NOSHOW to SDECAPPT and raises refresh event to running GUI clients
 ;
 Q:+$G(SDECNOEV)
 Q:'+$G(SDECSC)
 ;Q:$G(SDATA("AFTER","STATUS"))["AUTO RE-BOOK"
 N SDECSTAT,SDECFOUND,SDECRES
 S SDECSTAT=1
 ;S:$G(SDATA("BEFORE","STATUS"))["NO-SHOW" SDECSTAT=0
 S SDECFOUND=0
 I $D(^SDEC(409.831,"ALOC",SDECSC)) S SDECRES=$O(^SDEC(409.831,"ALOC",SDECSC,0)) S SDECFOUND=$$NOSEVT1(SDECRES,SDECSTART,SDECPAT,SDECSTAT)
 I SDECFOUND D NOSEVT3(SDECRES) Q
 Q
 ;
NOSEVT1(SDECRES,SDECSTART,SDECPAT,SDECSTAT) ;
 ;Get appointment id in SDECAPT
 ;If found, call SDECNOS(SDECAPPT) and return 1
 ;else return 0
 N SDECFOUND,SDECAPPT
 S SDECFOUND=0
 Q:'+$G(SDECRES) SDECFOUND
 Q:'$D(^SDEC(409.84,"ARSRC",SDECRES,SDECSTART)) SDECFOUND
 S SDECAPPT=0 F  S SDECAPPT=$O(^SDEC(409.84,"ARSRC",SDECRES,SDECSTART,SDECAPPT)) Q:'+SDECAPPT  D  Q:SDECFOUND
 . S SDECNOD=$G(^SDEC(409.84,SDECAPPT,0)) Q:SDECNOD=""
 . I $P(SDECNOD,U,5)=SDECPAT,$P(SDECNOD,U,12)="" S SDECFOUND=1 Q
 I SDECFOUND,+$G(SDECAPPT) D SDECNOS(SDECAPPT,SDECSTAT)
 Q SDECFOUND
 ;
NOSEVT3(SDECRES) ;
 ;Call RaiseEvent to notify GUI clients
 ;
 Q
 N SDECRESN
 S SDECRESN=$G(^SDEC(409.831,SDECRES,0))
 Q:SDECRESN=""
 S SDECRESN=$P(SDECRESN,"^")
 ;D EVENT^BMXMEVN("SDEC SCHEDULE",SDECRESN)
 Q
 ;
 ;
ERR(SDECERID,ERRTXT) ;Error processing
 S:'+$G(SDECI) SDECI=999999
 S SDECI=SDECI+1
 S ^TMP("SDEC",$J,SDECI)=SDECERID_"^"_ERRTXT_$C(30)
 S SDECI=SDECI+1
 S ^TMP("SDEC",$J,SDECI)=$C(31)
 Q
 ;
ETRAP ;EP Error trap entry
 D ^%ZTER
 I '$D(SDECI) N SDECI S SDECI=999999
 S SDECI=SDECI+1
 D ERR(0,"SDEC31 Error")
 Q
 ;
IMHERE(SDECRES) ;I'm Here
 ;IMHERE(SDECRES)  external parameter tag is in SDEC
 ;Entry point for SDEC IM HERE remote procedure
 ; Returns a simple value to client.  Used to establish continued existence
 ; of the client to the server; resets the server READ timeout.
 S SDECRES=1
 Q
 ;