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

SDRRISRU.m

Go to the documentation of this file. 
  1. SDRRISRU ;ALB/MAH,BWF,JAS - Recall Reminder Utilities ;NOV 25, 2024
  1.  ;;5.3;Scheduling;**536,627,648,799,818,866,895**;Aug 13, 1993;Build 11
  1.  ;;Per VHA Directive 6402, this routine should not be modified
  1.  ;
  1. OPENSLOT(SDRRIEN,SDRRST,SDRRND) ; Function returns the number of open (available)
  1.  ; slots at the clinic during the time period.
  1.  ; SDRRIEN - IEN of clinic in file #44
  1.  ; SDRRST  - (optional) start checking on this date (default=today)
  1.  ; SDRRND  - (optional) end of time period (default=last day of month)
  1.  N SDRRNOAV,SDRRTOT,SDRRHOL,SDRRT,SDRRTPT,SDRRTPDT,SDRRDT,SDRRDA
  1.  N SDRRFTR,CK,CLIN1,DA,DFN
  1.  I '$D(SDRRST) S SDRRST=DT
  1.  I '$D(SDRRND) D  ; end of month
  1.  . S SDRRND=$E($$SCH^XLFDT("1M(L)",SDRRST),1,7)
  1.  . S SDRRND=$$FMADD^XLFDT(SDRRND,1)
  1.  . Q:$E(SDRRST,1,5)=$E(SDRRND,1,5)
  1.  . S SDRRND=$$FMADD^XLFDT($E(SDRRND,1,5)_"01",-1)
  1.  S SDRRST=$$FMADD^XLFDT(SDRRST,-1)
  1.  S SDRRNOAV=0
  1.  I '$O(^SC(SDRRIEN,"OST",SDRRST)),'$O(^SC(SDRRIEN,"ST",SDRRST,0)) D
  1.  . N SDRRI,SDRRDOW
  1.  . F SDRRI=0:1:6 S SDRRDOW=$O(^SC(SDRRIEN,"T"_SDRRI,SDRRST)) Q:SDRRDOW  S:SDRRDOW SDRRNOAV=1
  1.  I SDRRNOAV Q 0  ; No future dates available
  1.  I '$D(SDRRYEAR) N SDRRYEAR D YEAR
  1.  S SDRRHOL=($P($G(^SC(SDRRIEN,"SL")),U,8)="Y")
  1.  S SDRRTOT=0,SDRRDT=SDRRST
  1.  F  S SDRRDT=$O(SDRRYEAR(SDRRDT)) Q:SDRRDT>SDRRND!'SDRRDT  D
  1.  . I 'SDRRHOL,$P(SDRRYEAR(SDRRDT),U,2) Q
  1.  . S SDRRTPDT=$G(^SC(SDRRIEN,"ST",SDRRDT,1)) ; Pattern
  1.  . I SDRRTPDT="" D  Q:SDRRTPDT=""
  1.  . . S SDRRT="T"_+SDRRYEAR(SDRRDT)
  1.  . . S SDRRTPT=$O(^SC(SDRRIEN,SDRRT,SDRRDT)) Q:SDRRTPT=""
  1.  . . S SDRRTPDT=$G(^SC(SDRRIEN,SDRRT,SDRRTPT,1))
  1.  . S SDRRTOT=SDRRTOT+$$AVAIL(SDRRTPDT)
  1.  Q SDRRTOT
  1. AVAIL(SDRRPAT) ; Given pattern, returns number of available slots.
  1.  ; Check the pattern for available slots
  1.  ; 0-9 and j-z = available slots where j=10, k=11...z=26
  1.  ; $A(1)=49 $A(9)=57 $A("j")=106 $A("z")=122
  1.  N SDRRCNT,SDRRCHAR,I
  1.  S SDRRCNT=0
  1.  S SDRRPAT=$TR($E(SDRRPAT,6,$L(SDRRPAT)),"|[] ","")
  1.  F I=1:1:$L(SDRRPAT) S SDRRCHAR=$A(SDRRPAT,I) D
  1.  . I SDRRCHAR>48,SDRRCHAR<58 S SDRRCNT=SDRRCNT+$C(SDRRCHAR) Q
  1.  . I SDRRCHAR>105,SDRRCHAR<123 S SDRRCNT=SDRRCNT+SDRRCHAR-96
  1.  Q SDRRCNT
  1. YEAR ; Set-up 1 year dates
  1.  ; This array is used for available appointments
  1.  N SDRRI,SDRRDT
  1.  S SDRRDT=SDRRST
  1.  F SDRRI=1:1:365 D  Q:SDRRDT=SDRRND
  1.  . S SDRRDT=$$FMADD^XLFDT(SDRRDT,1)
  1.  . S SDRRYEAR(SDRRDT)=$$DOW^XLFDT(SDRRDT,1)
  1.  . I $D(^HOLIDAY(SDRRDT)) S $P(SDRRYEAR(SDRRDT),U,2)=1
  1.  Q
  1. DELETE ; This entry point is invoked by the new style xref A66201 on the .01 field of file 403.5
  1.  I $D(SDRRDA),$D(APPT),$D(CLIN1) D  Q
  1.  .D DELAPPT(SDRRDA,APPT,CLIN1)
  1.  D DELUSER(DA)
  1.  Q
  1. DELAPPT(SDRRIEN,APPT,CLIN1) ; Record deleted from Recall List because of appointment.
  1.  N SDRRFDA
  1.  S SDRRFDA(403.56,"+1,",101)=APPT ; appt date
  1.  S SDRRFDA(403.56,"+1,",102)=CLIN1 ; appt clinic
  1.  ; SD*648 - Add delete info
  1.  S SDRRFDA(403.56,"+1,",201)=$E($$NOW^XLFDT(),1,12) ; delete date
  1.  S SDRRFDA(403.56,"+1,",202)=DUZ ; delete clerk
  1.  S:$G(SDRRFTR) SDRRFDA(403.56,"+1,",203)=SDRRFTR ; delete reason:
  1.  D DELSET(SDRRIEN,.SDRRFDA)
  1.  Q
  1. DELUSER(SDRRIEN) ; Record deleted by a user.
  1.  N SDRRFDA
  1.  S SDRRFDA(403.56,"+1,",201)=$E($$NOW^XLFDT(),1,12) ; delete date
  1.  ; DELUSER is defined by SDES2DISPRECALL to ensure the correct user is defined as the delete clerk
  1.  ; This will not be new'ed or killed in this routine. DELUSER is newed in SDES2DISPRECALL,
  1.  ; which is firing off this trigger cross reference.
  1.  S SDRRFDA(403.56,"+1,",202)=$S($G(DELUSER):$G(DELUSER),1:DUZ) ; delete clerk
  1.  S:$G(SDRRFTR) SDRRFDA(403.56,"+1,",203)=SDRRFTR ; delete reason:
  1.  D DELSET(SDRRIEN,.SDRRFDA)
  1.  Q
  1. DELSET(SDRRIEN,SDRRFDA) ;
  1.  N SDRRREC,EAS,NEWIEN,APPTIEN,FDA,RREMIEN
  1.  S SDRRREC=$G(^SD(403.5,SDRRIEN,0))
  1.  S EAS=$G(^SD(403.5,SDRRIEN,1))
  1.  S SDRRFDA(403.56,"+1,",.01)=$P(SDRRREC,U,1) ; patient
  1.  S SDRRFDA(403.56,"+1,",2)=$P(SDRRREC,U,3)   ; accession #
  1.  S SDRRFDA(403.56,"+1,",2.5)=$$CTRL^XMXUTIL1($P(SDRRREC,U,7)) ; comment
  1.  S SDRRFDA(403.56,"+1,",2.6)=$P(SDRRREC,U,8) ; fast / non-fast
  1.  S SDRRFDA(403.56,"+1,",3)=$P(SDRRREC,U,4)   ; test/app.
  1.  S SDRRFDA(403.56,"+1,",4)=$P(SDRRREC,U,5)   ; provider
  1.  S SDRRFDA(403.56,"+1,",4.5)=$P(SDRRREC,U,2) ; clinic
  1.  S SDRRFDA(403.56,"+1,",4.7)=$P(SDRRREC,U,9) ; length of appt.
  1.  S SDRRFDA(403.56,"+1,",5)=$P(SDRRREC,U,6)   ; recall date
  1.  S SDRRFDA(403.56,"+1,",6)=$P(SDRRREC,U,10)  ; date reminder sent
  1.  S SDRRFDA(403.56,"+1,",7)=$P(SDRRREC,U,11)  ; user who entered recall
  1.  S SDRRFDA(403.56,"+1,",7.5)=$P(SDRRREC,U,14) ;DATE/TIME RECALL ADDED
  1.  S SDRRFDA(403.56,"+1,",100)=EAS ;EAS TRACKING NUMBER ADDED
  1.  D UPDATE^DIE("","SDRRFDA","NEWIEN")
  1.  S RREMIEN=$G(NEWIEN(1)) I 'RREMIEN Q
  1.  ;
  1.  N CAFDA
  1.  S CAFDA(403.58,"+1,"_RREMIEN_",",.01)=$$NOW^XLFDT
  1.  S CAFDA(403.58,"+1,"_RREMIEN_",",1)=$P(SDRRREC,U,11)
  1.  S CAFDA(403.58,"+1,"_RREMIEN_",",2)=$$CTRL^XMXUTIL1($P(SDRRREC,U,7))
  1.  D UPDATE^DIE("","CAFDA") K CAFDA
  1.  ;
  1.  S APPTIEN=$$GETAPPT(SDRRIEN) Q:'APPTIEN
  1.  S FDA(409.84,APPTIEN_",",5.1)=RREMIEN D FILE^DIE(,"FDA") K FDA
  1.  Q
  1. GETAPPT(RECALLIEN) ;
  1.  N FILEROOT,FULLREF,APPTIEN,SDPATIEN,TRGTAPPT
  1.  S TRGTAPPT=""
  1.  S SDPATIEN=$$GET1^DIQ(403.5,RECALLIEN,.01,"I")
  1.  S FILEROOT=$$ROOT^DILFD(403.5)
  1.  S FULLREF=RECALLIEN_";"_$P(FILEROOT,U,2)
  1.  S APPTIEN=0 F  S APPTIEN=$O(^SDEC(409.84,"CPAT",SDPATIEN,APPTIEN)) Q:'APPTIEN  D
  1.  .I $$GET1^DIQ(409.84,APPTIEN,.22,"I")'=FULLREF Q
  1.  .S TRGTAPPT=APPTIEN
  1.  Q $G(TRGTAPPT)