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

SDEC58.m

Go to the documentation of this file. 
  1. SDEC58 ;ALB/SAT - VISTA SCHEDULING RPCS ;APR 08, 2016
  1.  ;;5.3;Scheduling;**627,642**;Aug 13, 1993;Build 23
  1.  ;
  1.  Q
  1.  ;
  1.  ;Compensation & Pension Appointments RPC
  1.  ;SDECY    = global variable return
  1.  ;DFN      = patient IEN (required)
  1.  ;SDAMEVT  = event type (1=make appt,2=cancel,3=no show) (required)
  1.  ;SDT      = original appt date/time (required)
  1.  ;SDAUTORB = set to 1 if auto rebook (optional)
  1.  ;SDCANVET = set to 1 if appt cancelled by VET (optional)
  1. CAP(SDECY,DFN,SDAMEVT,SDT,SDAUTORB,SDCANVET) ;
  1.  ;** Variable Descriptions
  1.  ;** SDAMEVT = 1 Make appointment event
  1.  ;**           2 Cancel appointment event
  1.  ;**           3 No Show appointment event
  1.  ;** I DVBAAUTO exists, AMIE Make Event is not executed because
  1.  ;**  cancel/no show part of auto-rebook updated 396.95
  1.  ;** SDT   = Time In
  1. EN ;**AMIE Scheduling event driver main entry point
  1.  N SDECI,DVBADFN,SDERR
  1.  S SDECY="^TMP(""SDEC58"","_$J_",""CAP"")"
  1.  K @SDECY
  1.  S SDECI=0,SDERR=0
  1.  S @SDECY@(SDECI)="T00020RETURNCODE^T00100TEXT"_$C(30)
  1.  I $G(DFN)']"" S SDECI=SDECI+1,@SDECY@(SDECI)="-1^Invalid Patient DFN"_$C(30) S SDERR=1 G XIT
  1.  I $G(SDT)']"" S SDECI=SDECI+1,@SDECY@(SDECI)="-1^Invalid Original Appt Date and Time"_$C(30) S SDERR=1 G XIT
  1.  ;auto rebook variable
  1.  S:+$G(SDAUTORB) DVBAAUTO=""
  1.  ;appt cancelled by VET variable
  1.  S:+$G(SDCANVET) DVBAVTRQ=""
  1.  S DVBATYPE=$P($G(^DPT(DFN,"S",SDT,0)),U,16)
  1.  ;appt type must be COMPENSATION & PENSION
  1.  I +DVBATYPE=1 D
  1.  .I +SDAMEVT=1,('$D(DVBAAUTO)) D EN1 ;** Original Make event (SDAMEVT=1)
  1.  .I +SDAMEVT=1,($D(DVBAAUTO)) K DVBAAUTO ;** Auto-rebook Make event (SDAMEVT=1)
  1.  .I +SDAMEVT=2!(+SDAMEVT=3) D EN2 ;** Cancel/No show event (SDAMEVT=2 or 3)
  1.  K DVBATYPE
  1.  S:SDERR=0 SDECI=SDECI+1,@SDECY@(SDECI)="0^No Error"_$C(30)
  1. XIT ;
  1.  S @SDECY@(SDECI)=@SDECY@(SDECI)_$C(31)
  1.  D KVARS
  1.  Q
  1. EN1 ;
  1.  S DVBADFN=DFN,DVBASTAT="P" ;DVBASTAT used in REQARY^DVBCUTL5
  1.  D GETIEN
  1.  Q:SDERR=1
  1.  D LINKAPPT
  1.  D KVARS
  1.  Q
  1. LINKAPPT ;
  1.  ;**No appointments exist for 2507
  1.  I '$D(^DVB(396.95,"AR",DVBADA)) D CRTREC
  1.  Q
  1. CRTREC ;
  1.  S DVBAADT=SDT
  1.  S DIC="^DVB(396.95,",X=DVBAADT,DIC(0)="LX",DLAYGO="396.95"
  1.  S DIC("DR")=".02////^S X=DVBAADT;.03////^S X=DVBAADT;"
  1.  S DIC("DR")=DIC("DR")_".04////^S X=0;.06////^S X=DVBADA;"
  1.  S DIC("DR")=DIC("DR")_".07////^S X=1"
  1.  D FILE^DICN
  1.  K DIC,X,DLAYGO,DVBAADT
  1.  Q
  1. KVARS ;** Kill variables used by scheduling protocol
  1.  K DVBADA,DVBASTAT,SDAUTORB,SDCANVET,Y
  1.  Q
  1. EN2 ;
  1.  ;**Find the respective AMIE appointment record
  1.  S DVBASTAT=$P($G(^DPT(DFN,"S",SDT,0)),U,2)
  1.  ;**Get the date being canceled
  1.  S DVBACURA=SDT
  1.  S (DVBAAPDA,DVBALKDA)=""
  1.  S DVBAUPDT=0
  1.  K DVBAFND
  1.  S LNKCNT=0
  1.  F  S DVBAAPDA=$O(^DVB(396.95,"CD",DVBACURA,DVBAAPDA)) Q:(DVBAAPDA="")  D
  1.  .S DVBARQDA=$P(^DVB(396.95,DVBAAPDA,0),U,6)
  1.  .I $P(^DVB(396.3,DVBARQDA,0),U,1)=DFN D
  1.  ..S LNKCNT=LNKCNT+1
  1.  ..S:(+$P(^DVB(396.95,DVBAAPDA,0),U,7)=1) DVBAFND="",DVBALKDA=DVBAAPDA
  1.  ..I '$D(DVBAFND),($P(^DVB(396.95,DVBAAPDA,0),U,8)>DVBAUPDT) D
  1.  ...S DVBAUPDT=$P(^DVB(396.95,DVBAAPDA,0),U,8) ;**Keep latest cancel dte
  1.  ...S DVBALKDA=DVBAAPDA ;**Keep DA of rec last cancelled
  1.  I (DVBASTAT="PCA")!((DVBASTAT="NA")!(DVBASTAT="CA")) S DVBAAUTO=""
  1.  ;
  1.  ;auto-rbk
  1.  I $D(DVBAAUTO),($D(DVBAFND)!('$D(DVBAFND)&(+LNKCNT>0))) D
  1.  .S DVBAAPDT=$P($G(^DPT(DFN,"S",SDT,0)),U,10)
  1.  .K DVBAVTRQ ;**Set if appointment canceled by vet
  1.  .S:(DVBASTAT["P"!(DVBASTAT["N"&(DVBASTAT'="NT"))) DVBAVTRQ=""
  1.  .;Update Appt record with reschedule data
  1.  .D RSCHAPT(DVBALKDA,DVBAAPDT)
  1.  I '$D(DVBAAUTO),$D(DVBAFND) D  ;**Appt linked, not Auto
  1.  .D CANCEL
  1.  I +LNKCNT>1 D
  1.  .S SDECI=SDECI+1,@SDECY@(SDECI)="-1^This C&P appointment has multiple links with the same Current Appt Date."_$C(30)
  1.  .S SDERR=1
  1.  D KVARS2
  1.  Q
  1. KVARS2 ;
  1.  K DVBAAPDA,DVBAFND,DVBASTAT,DVBAAPDT,DVBARQDA
  1.  K DVBAVTRQ,DVBALKDA,LNKCNT,DVBAUPDT,DVBACURA
  1.  Q
  1. CANCEL ;** Cancel C&P Appt
  1.  N DVBCUPDT
  1.  D NOW^%DTC
  1.  S DVBCUPDT=%
  1.  K %,X
  1.  S DA=+DVBALKDA,DIE="^DVB(396.95,",DR=""
  1.  I DVBASTAT["PC"!(DVBASTAT["N"&(DVBASTAT'="NT")) D
  1.  .S DR=".04////^S X=1;" ;** Set .04 if vet cancel
  1.  S DR=DR_".07////^S X=0;.08////^S X=DVBCUPDT"
  1.  D ^DIE K DA,DIE,DR
  1.  Q
  1.  ;
  1. RSCHAPT(LKDA,RSCHDT) ;** Update Appt record with reschedule data
  1.  S DA=+LKDA,DIE="^DVB(396.95,",DR=".03////^S X=RSCHDT;.07////1"
  1.  S:(+$P(^DVB(396.95,DA,0),U,4)=0&('$D(DVBAVTRQ))) DR=".02////^S X=RSCHDT;"_DR
  1.  S:($D(DVBAVTRQ)) DR=".04////^S X=1;.05////^S X=RSCHDT;"_DR
  1.  D ^DIE K DA,DIE,DR
  1.  Q
  1.  ;
  1. GETIEN ;Get IEN for 2507 REQUEST file
  1.  N DVBACNT,DVBADT,DVBAORD,DVBASDPR
  1.  K ^TMP("DVBC",$J)
  1.  S (DVBADA,DVBASDPR)=""
  1.  D REQARY^DVBCUTL5 ;**Set up ^TMP of AMIE 2507's
  1.  I +DVBACNT>0 D
  1.  .I +DVBACNT=1 D  ;**Auto select 2507 if only one exists
  1.  ..S (DVBADT,DVBADA,DVBAORD)=""
  1.  ..S DVBAORD=$O(^TMP("DVBC",$J,DVBAORD))
  1.  ..S DVBADT=$O(^TMP("DVBC",$J,DVBAORD,DVBADT))
  1.  ..S DVBADA=$O(^TMP("DVBC",$J,DVBAORD,DVBADT,DVBADA))
  1.  .I +DVBACNT>1 D  ;**If more than one 2507 exists
  1.  ..S SDECI=SDECI+1,@SDECY@(SDECI)="-1^More than one 2507 request exisits for this patient!"_$C(30)
  1.  ..S SDERR=1
  1.  .K ^TMP("DVBC",$J)
  1.  .Q:SDERR=1
  1.  .I '$D(^DVB(396.3,+DVBADA,0)),(+$$ENHNC^DVBCUTA4=1) D  Q  ;**Write warning
  1.  ..S SDECI=SDECI+1,@SDECY@(SDECI)="-1^You have not selected a 2507 request to link the C&P appointment to."_$C(30)
  1.  ..S SDECI=SDECI+1,@SDECY@(SDECI)="-1^ The appointment should be linked with the AMIE/C&P Appointment Link"_$C(30)
  1.  ..S SDECI=SDECI+1,@SDECY@(SDECI)="-1^ Management Option to ensure proper processing time calculation for this 2507"_$C(30)
  1.  ..S SDECI=SDECI+1,@SDECY@(SDECI)="-1^ in the event of a veteran cancellation."_$C(30)
  1.  ..S SDERR=1
  1.  .I $D(^DVB(396.3,+DVBADA,0)) D LINKAPPT ;**If 2507, link appt
  1.  I +DVBACNT'>0,(+$$ENHNC^DVBCUTA4=1) D  ;**Write Warning
  1.  .S SDECI=SDECI+1,@SDECY@(SDECI)="-1^You have made a C&P appointment for a patient who has no pending 2507 request!"_$C(30)
  1.  .S SDERR=1
  1.  Q
  1.  ;