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

SDECCAP.m

Go to the documentation of this file.
  1. SDECCAP ;ALB/SAT,WTC - VISTA SCHEDULING RPCS ;Feb 12, 2020@15:22
  1. ;;5.3;Scheduling;**642,694**;Aug 13, 1993;Build 61
  1. ;
  1. Q
  1. ;
  1. GET(SDECY,DFN,SDCL,SDT,TYPE,APTYPE) ;GET entries from 2507 REQUEST file 396.3
  1. ;INPUT:
  1. ; DFN - (required) Patient ID pointer to PATIENT file 2
  1. ; SDCL - (required) Clinic ID pointer to HOSPITAL LOCATION file 44
  1. ; SDT - (required) Appointment Date/Time in external format
  1. ; TYPE - (required) O:MAKE
  1. ; R:REBOOK
  1. ; C:CANCEL or NO SHOW
  1. ; APTYPE - (required) Must be 1 for COMP and Pen
  1. ;RETURN:
  1. ; REQIEN - 2507 REQUEST id pointer to 2507 REQUEST file 396.3
  1. ; IEN - Patient ID pointer to PATIENT file 2
  1. ; NAME - Patient name from PATIENT file 2
  1. ; DATE - Request Date in external format (field #1)
  1. ; EXISTS - Flag to indicate that a 2507 REQUEST already has an appointment.
  1. ; This is indicated by an entry in file 396.95
  1. ; 0=No; 1=Yes
  1. ; APPT_LINKS - Appointment Links separated by pipe |
  1. ; each pipe piece contains the following ~ pieces
  1. ; 1. Link ID - Pointer to AMIE C&P EXAM TRACKING file 396.95
  1. ; 2. Initial Appt - Date/time in external format
  1. ; 3. Clock Stop Appt - Date/time in external format
  1. ; 4. Current Appt - Date/time in external format
  1. ; 5. Clinic Name - Name from HOSPITAL LOCATION
  1. ;
  1. N %DT,X,Y
  1. N SDDA,SDECI,SDMKHDL
  1. S SDECI=0
  1. S SDECY="^TMP(""SDECCAP"","_$J_",""CAPGET"")"
  1. K @SDECY
  1. S @SDECY@(SDECI)="T00030REQIEN^T00030IEN^T00030NAME^T00030DATE^T00030EXISTS^T00250APPT_LINKS"_$C(30)
  1. ;validate DFN
  1. S DFN=$G(DFN)
  1. I ('+DFN)!('$D(^DPT(+DFN,0))) S @SDECY@(1)="-1^Invalid patient ID."_$C(30,31) Q
  1. ;validate SDCL
  1. S SDCL=$G(SDCL)
  1. I ('+SDCL)!('$D(^SC(+SDCL,0))) S @SDECY@(1)="-1^Invalid clinic ID."_$C(30,31) Q
  1. ;validate SDT
  1. S SDT=$G(SDT)
  1. S %DT="RXT",X=SDT D ^%DT S SDT=Y
  1. S SDDA=0 F S SDDA=$O(^SC(SDCL,"S",SDT,1,SDDA)) Q:SDDA'>0 Q:$P($G(^SC(SDCL,"S",SDT,1,SDDA,0)),U,1)=DFN
  1. I SDDA="" S @SDECY@(1)="-1^Appointment not found."_$C(30,31) Q
  1. I SDT=-1 S @SDECY@(1)="-1^Invalid appointment date/time."_$C(30,31) Q
  1. ;validate TYPE
  1. S TYPE=$G(TYPE)
  1. I "ORC"'[TYPE S @SDECY@(1)="-1^Type must be O:Original Make, R for Rebook, or C for Cancel/No Show."_$C(30,31) Q
  1. ;validate APTYPE
  1. S APTYPE=$G(APTYPE)
  1. I APTYPE'=1 S @SDECY@(1)="-1^Only Comp & Pen is currently supported."_$C(30,31) Q
  1. ;from MAKE^SDAMEVT
  1. K ^TMP("SDAMEVT",$J)
  1. S SDMKHDL=$$HANDLE^SDAMEVT(1)
  1. S (^TMP("SDAMEVT",$J,"BEFORE","DPT"),^TMP("SDAMEVT",$J,"BEFORE","SC"),^TMP("SDAMEVT",$J,"BEFORE","STATUS"))=""
  1. S SDATA("BEFORE","STATUS")=""
  1. S (^TMP("SDEVT",$J,SDMKHDL,1,"DPT",0,"BEFORE"),^TMP("SDEVT",$J,SDMKHDL,1,"SC",0,"BEFORE"))=""
  1. S (^TMP("SDEVT",$J,SDMKHDL,1,"DPT",0,"AFTER"),^TMP("SDEVT",$J,SDMKHDL,1,"SC",0,"AFTER"))=""
  1. ;D AFTER^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDMKHDL)
  1. S SDATA=SDDA_U_DFN_U_SDT_U_SDCL
  1. D EVT(.SDATA,1,0,SDMKHDL)
  1. ;
  1. S @SDECY@(SDECI)=@SDECY@(SDECI)_$C(31)
  1. Q
  1. ;
  1. EVT(SDATA,SDAMEVT,SDMODE,SDHDL) ;EVT^SDAMEVT
  1. K DTOUT,DIROUT
  1. S:$P(SDATA,U,3) $P(SDATA,U,5)=$$REQ^SDM1A(+$P(SDATA,U,3))
  1. D EN
  1. Q
  1. ;
  1. ;from EN^DVBCSDEV
  1. EN ;**AMIE Scheduling event driver main entry point
  1. K KDFN I '$D(DFN) N DFN S DFN=$P(SDATA,U,2),KDFN=""
  1. S DVBAORG=$$SDORGST^DVBCUTL5
  1. I +DVBAORG=1 D
  1. .S DVBAXST=$$SDEVTXST^DVBCUTL5
  1. .I +DVBAXST=1 D
  1. ..S DVBATYPE=1 ;$$SDEVTSPC^DVBCUTL5(16)
  1. ..I +DVBATYPE=1 D
  1. ...I +SDAMEVT=1 D EN1 ;EN^DVBCMKLK ;** Original Make event
  1. ...;I +SDAMEVT=1,($D(DVBAAUTO)) K DVBAAUTO ;** Auto-rebook Make event
  1. ...I +SDAMEVT=2 D ENCAN ;EN^DVBCCNNS ;** Cancel/No show event
  1. ..K DVBATYPE
  1. .K DVBAXST
  1. K DVBAORG
  1. I $D(KDFN) K KDFN,DFN
  1. D KVARS^DVBCMKLK
  1. Q
  1. ;
  1. ;from DVBCMKLK
  1. EN1 ;** Link C&P appointment to 2507
  1. N DVBADFN,DVBASDPR,DVBASTAT
  1. N SDI,SDJ,DVBADA,SDL,SDLINKS,SDM,SDTMP,TMP,TMP1
  1. S DVBADFN=DFN,DVBASTAT="P" ;**DVBASTAT used in REQARY^DVBCUTL5
  1. ;
  1. ;**If user entered from AMIE Scheduling, only prompted if enhanced
  1. ;** dialogue turned on and is needed
  1. ;** QUIT on next line if from DVBCSCHD
  1. ;I $D(DVBASDRT) S DVBADA=REQDA D LINKAPPT^DVBCMKL2,KVARS QUIT ;*DVBCSCHD
  1. S (DVBADA,DVBASDPR)=""
  1. D REQARY^DVBCUTL5 ;**Set up ^TMP of AMIE 2507's
  1. ;^TMP("DVBC",8945,6889775.889799,3110224.1102,34231)=""
  1. ; Inverse REQUEST DATE, REQUEST DATE, IEN)
  1. S SDI="" F S SDI=$O(^TMP("DVBC",$J,SDI)) Q:SDI="" D
  1. .S SDJ="" F S SDJ=$O(^TMP("DVBC",$J,SDI,SDJ)) Q:SDJ="" D
  1. ..S DVBADA="" F S DVBADA=$O(^TMP("DVBC",$J,SDI,SDJ,DVBADA)) Q:DVBADA="" D
  1. ...S $P(SDTMP,U,1)=DVBADA ;2507 REQUEST id
  1. ...S $P(SDTMP,U,2)=DFN
  1. ...S $P(SDTMP,U,3)=$$GET1^DIQ(2,DFN_",",.01)
  1. ... ;
  1. ... ; Change date/time conversion so midnight is handled properly. wtc 694 5/17/18
  1. ... ;
  1. ... S $P(SDTMP,U,4)=$$FMTONET^SDECDATE(SDJ) ;
  1. ... ;S $P(SDTMP,U,4)=$$FMTE^XLFDT(SDJ)
  1. ... S $P(SDTMP,U,5)=+$E($D(^DVB(396.95,"AR",+DVBADA)),1)
  1. ...D
  1. ....K TMP("DVBC LINK")
  1. ....S SDLINKS="" ;SDLINKS | ~
  1. ....D LNKARY^DVBCUTA3(DVBADA,DFN)
  1. ....S SDL="" F S SDL=$O(TMP("DVBC LINK",SDL)) Q:SDL="" D
  1. .....S SDM="" F S SDM=$O(TMP("DVBC LINK",SDL,SDM)) Q:SDM="" D
  1. ......S TMP1=SDM_"~"_$TR(TMP("DVBC LINK",SDL,SDM),"^","~")
  1. ......S SDLINKS=SDLINKS_$S(SDLINKS'="":"|",1:"")_TMP1
  1. ...S $P(SDTMP,U,6)=SDLINKS
  1. ...S SDECI=SDECI+1 S @SDECY@(SDECI)=SDTMP_$C(30)
  1. K ^TMP("DVBC LINK")
  1. Q
  1. ;
  1. ;
  1. SET(SDECY,REQIEN,APPTLNK,VETREQ,SDCL,SDT) ;SET entries to AMIE C&P EXAM TRACKING file 396.95 and update file 396.3
  1. ;INPUT:
  1. ; 1. REQIEN - (required) 2507 REQUEST id pointer to 2507 REQUEST file 396.3
  1. ; 2. APPTLNK - (optional) Appointment Link with the following ~ pieces: (a new link will be made if this is null)
  1. ; 1. Link ID - Pointer to AMIE C&P EXAM TRACKING file 396.95
  1. ; 2. Initial Appt - Date/time in external format
  1. ; 3. Clock Stop Appt - Date/time in external format
  1. ; 4. Current Appt - Date/time in external format
  1. ; 5. Clinic Name - Name from HOSPITAL LOCATION
  1. ; 3. VETREQ - (optional) Veteran Request flag - (field .04 in file 396.95)
  1. ; "Is this appointment due to a veteran requested cancellation or 'No Show'"
  1. ; 0=NO; 1=YES
  1. ; 4. SDCL - (required) pointer to HOSPITAL LOCATION file 44
  1. ; 5. SDT - (required) Appointment date/time in external format
  1. ;RETURN:
  1. ; CODE ^ MESSAGE
  1. N DFN,DVBADA,DVBALKRC,DVBAVTRQ
  1. N SDDA,SDECI
  1. S SDECI=0
  1. S SDECY="^TMP(""SDECCAP"","_$J_",""CAPSET"")"
  1. K @SDECY
  1. S @SDECY@(SDECI)="T00030CODE^T00250MESSAGE"_$C(30)
  1. ;validate REQIEN
  1. S (REQIEN,DVBADA)=$G(REQIEN)
  1. I '+REQIEN S @SDECY@(1)="-1^Invalid 2507 REQUEST id."_$C(30,31) Q
  1. I '$D(^DVB(396.3,+REQIEN,0)) S @SDECY@(1)="-1^Invalid 2507 REQUEST id."_$C(30,31) Q
  1. S DFN=$$GET1^DIQ(396.3,REQIEN_",",.01,"I")
  1. ;validate APPTLNK
  1. S APPTLNK=$G(APPTLNK)
  1. ;validate VETREQ
  1. S VETREQ=$G(VETREQ)
  1. I VETREQ'=1,VETREQ'=2 S VETREQ=""
  1. ;validate SDCL
  1. S SDCL=$G(SDCL)
  1. I ('+SDCL)!('$D(^SC(+SDCL,0))) S @SDECY@(1)="-1^Invalid clinic ID."_$C(30,31) Q
  1. ;validate SDT
  1. S SDT=$G(SDT)
  1. S %DT="RXT",X=SDT D ^%DT S SDT=Y
  1. I SDT=-1 S @SDECY@(1)="-1^Invalid appointment date/time."_$C(30,31) Q
  1. S SDDA=0 F S SDDA=$O(^SC(SDCL,"S",SDT,1,SDDA)) Q:SDDA'>0 Q:$P($G(^SC(SDCL,"S",SDT,1,SDDA,0)),U,1)=DFN
  1. I SDDA="" S @SDECY@(1)="-1^Appointment not found."_$C(30,31) Q
  1. ;
  1. ;from MAKE^SDAMEVT
  1. ;K ^TMP("SDAMEVT",$J)
  1. ;S SDMKHDL=$$HANDLE^SDAMEVT(1)
  1. ;S (^TMP("SDAMEVT",$J,"BEFORE","DPT"),^TMP("SDAMEVT",$J,"BEFORE","SC"),^TMP("SDAMEVT",$J,"BEFORE","STATUS"))=""
  1. ;S SDATA("BEFORE","STATUS")=""
  1. ;S (^TMP("SDEVT",$J,SDMKHDL,1,"DPT",0,"BEFORE"),^TMP("SDEVT",$J,SDMKHDL,1,"SC",0,"BEFORE"))=""
  1. ;S (^TMP("SDEVT",$J,SDHDL,1,"DPT",0,"AFTER"),^TMP("SDEVT",$J,SDHDL,1,"SC",0,"AFTER"))=""
  1. ; ;D AFTER^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDMKHDL)
  1. S SDATA=SDDA_U_DFN_U_SDT_U_SDCL
  1. I APPTLNK="" D CRTREC S @SDECY@(1)=+Y_U_"AMIE C&P EXAM TRACKING record added"_$C(30,31) G SETX
  1. I APPTLNK'="" S DVBALKRC=$P(APPTLNK,"~",1),DVBAVTRQ=VETREQ D UPDTLK S @SDECY@(1)=DVBALKRC_U_"AMIE C&P EXAM TRACKING record updated"_$C(30,31) G SETX
  1. S @SDECY@(1)="-1^No updates made"_$C(30,31)
  1. SETX ;
  1. Q
  1. CRTREC ;** Add a record to file 396.95 (Appt Tracking)
  1. N DIC,DD,DLAYGO,DO,DVBAADT,X
  1. S DVBAADT=$P(SDATA,U,3)
  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 K DIC,X,DLAYGO,DVBAADT
  1. Q
  1. UPDTLK ;** Update selected 396.95 link
  1. N DVBARSAP
  1. S DVBARSAP=$P(^DVB(396.95,DVBALKRC,0),U,3)
  1. K Y,DIR D RSCHAPT(DVBALKRC,$P(SDATA,U,3))
  1. K DVBAVTRQ
  1. N DVBAAPST
  1. S DVBAAPST=$P(^DPT(DFN,"S",SDT,0),U,2)
  1. Q
  1. RSCHAPT(LKDA,RSCHDT) ;** Update Appt record with reschedule data ;from DVBCMKLK
  1. N DA,DIE,DR
  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. CAN(SDECY,DFN,SDCL,SDT) ;SET AMIE C&P EXAM TRACKING as cancel
  1. ;INPUT:
  1. ; DFN - (required) Patient ID pointer to PATIENT file 2
  1. ; SDCL - (required) Clinic ID pointer to HOSPITAL LOCATION file 44
  1. ; SDT - (required) Appointment Date/Time in external format
  1. ;RETURN:
  1. ; an array of codes and messages:
  1. ; code ^ message
  1. ; code - -1=error -2=message to be displayed to the user
  1. N SDAMEVT,SDATA,SDCPHDL,SDECI,SDHDL
  1. N ZTQUEUED
  1. S ZTQUEUED=1
  1. S SDAMEVT=2
  1. S SDECI=0
  1. S SDECY="^TMP(""SDECCAP"","_$J_",""CAPSET"")"
  1. K @SDECY
  1. S @SDECY@(SDECI)="T00030REQIEN^T00030IEN^T00030NAME^T00030DATE^T00030EXISTS_T00250APPT_LINKS"_$C(30)
  1. ;validate DFN
  1. S DFN=$G(DFN)
  1. I ('+DFN)!('$D(^DPT(+DFN,0))) S @SDECY@(1)="-1^Invalid patient ID."_$C(30,31) Q
  1. ;validate SDCL
  1. S SDCL=$G(SDCL)
  1. I ('+SDCL)!('$D(^SC(+SDCL,0))) S @SDECY@(1)="-1^Invalid clinic ID."_$C(30,31) Q
  1. ;validate SDT
  1. S SDT=$G(SDT)
  1. S %DT="RXT",X=SDT D ^%DT S SDT=Y
  1. I SDT=-1 S @SDECY@(1)="-1^Invalid appointment date/time."_$C(30,31) Q
  1. S SDDA=0 F S SDDA=$O(^SC(SDCL,"S",SDT,1,SDDA)) Q:SDDA'>0 Q:$P($G(^SC(SDCL,"S",SDT,1,SDDA,0)),U,1)=DFN
  1. I SDDA="" S @SDECY@(1)="-1^Appointment not found."_$C(30,31) Q
  1. S (SDHDL,SDCPHDL)=$$HANDLE^SDAMEVT(1) D BEFORE^SDAMEVT(.SDATA,DFN,SDT,SDCL,"",SDCPHDL) ;CAN^SDCNP0
  1. ;D CANCEL^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,0,SDCPHDL) ;EVT^SDCNP0
  1. D AFTER^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCPHDL) ;CANCEL^SDAMEVT
  1. S SDATA=SDDA_U_DFN_U_SDT_U_SDCL
  1. D EVT(.SDATA,SDAMEVT,0,SDCPHDL)
  1. S @SDECY@(SDECI)=@SDECY@(SDECI)_$C(31)
  1. Q
  1. ;
  1. ENCAN ;from DVBCCNNS
  1. N DVBAAPDA,DVBAAUTO,DVBACURA,DVBAFND,DVBALKDA,DVBARQDA,DVBASTAT,DVBAUPDT
  1. N LNKCNT
  1. S DVBASTAT=$$SDEVTSPC^DVBCUTL5(2)
  1. S DVBACURA=$P(SDATA,U,3) ;**Get the date being canceled
  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. ;** Appt not linked, enhnc dilog on, not processing in background
  1. I LNKCNT=0 D
  1. .N DVBACROT,Y
  1. . ;
  1. . ; Change date/time conversion so midnight is handled properly. wtc 694 5/17/18
  1. . ;
  1. . S DVBACROT=$$FMTONET^SDECDATE(DVBACURA) ;
  1. . ;S Y=DVBACURA X ^DD("DD") S DVBACROT=Y K Y
  1. .S SDECI=SDECI+1 S @SDECY@(SDECI)="-2^Appointment "_DVBACROT_" was not linked to a 2507 request or was"
  1. .S SDECI=SDECI+1 S @SDECY@(SDECI)=" manually rebooked and linked to another appointment."
  1. .S SDECI=SDECI+1 S @SDECY@(SDECI)=" (If the appointment was manually rebooked, you do not want to auto-rebook.)"
  1. .S SDECI=SDECI+1 S @SDECY@(SDECI)="If the appointment was not properly linked, it will need to be linked with the"
  1. .S SDECI=SDECI+1 S @SDECY@(SDECI)=" AMIE/C&P appointment link management option."_$C(30)
  1. ;I $D(DVBAAUTO),($D(DVBAFND)!('$D(DVBAFND)&(+LNKCNT>0))) DO ;**Auto-rbk
  1. ;.S:(+$$SDEVTXST^DVBCUTL5=1) DVBAAPDT=$$SDEVTSPC^DVBCUTL5(10)
  1. ;.K DVBAVTRQ ;**Set if appointment canceled by vet
  1. ;.S:(DVBASTAT["P"!(DVBASTAT["N"&(DVBASTAT'="NT"))) DVBAVTRQ=""
  1. ;.D RSCHAPT^DVBCMKLK(DVBALKDA,DVBAAPDT)
  1. ;.D:((+$$ENHNC^DVBCUTA4=1)&('$D(ZTQUEUED))) CNCMSG
  1. I '$D(DVBAAUTO),($D(DVBAFND)) D ;**Appt linked, not Auto
  1. .D CANCEL^DVBCCNNS
  1. .S SDECI=SDECI+1 S @SDECY@(SDECI)="-2^The link has been updated."_$C(30)
  1. .;D:((+$$ENHNC^DVBCUTA4=1)&('$D(ZTQUEUED))) CNCMSG
  1. I +LNKCNT>1 D
  1. .S SDECI=SDECI+1 S @SDECY@(SDECI)="-2^This C&P appointment has multiple links with the same Current Appt Date."
  1. .S SDECI=SDECI+1 S @SDECY@(SDECI)=" Use the AMIE/C&P Appointment Link Management option to review and delete"
  1. .S SDECI=SDECI+1 S @SDECY@(SDECI)=" any duplicate links."_$C(30)
  1. D KVARS^DVBCCNNS
  1. Q