SDRRISRU ;10N20/MAH;Recall Reminder Utilities ;01/18/2008 11:32
;;5.3;PIMS;**1016**;JUN 30, 2012;Build 20
OPENSLOT(SDRRIEN,SDRRST,SDRRND) ; Function returns the number of open (available)
; slots at the clinic during the time period.
; SDRRIEN - IEN of clinic in file #44
; SDRRST - (optional) start checking on this date (default=today)
; SDRRND - (optional) end of time period (default=last day of month)
N SDRRNOAV,SDRRTOT,SDRRHOL,SDRRT,SDRRTPT,SDRRTPDT,SDRRDT,SDRRDA
N SDRRFTR,CK,CLIN1,DA,DFN
I '$D(SDRRST) S SDRRST=DT
I '$D(SDRRND) D ; end of month
. S SDRRND=$E($$SCH^XLFDT("1M(L)",SDRRST),1,7)
. S SDRRND=$$FMADD^XLFDT(SDRRND,1)
. Q:$E(SDRRST,1,5)=$E(SDRRND,1,5)
. S SDRRND=$$FMADD^XLFDT($E(SDRRND,1,5)_"01",-1)
S SDRRST=$$FMADD^XLFDT(SDRRST,-1)
S SDRRNOAV=0
I '$O(^SC(SDRRIEN,"OST",SDRRST)),'$O(^SC(SDRRIEN,"ST",SDRRST,0)) D
. N SDRRI,SDRRDOW
. F SDRRI=0:1:6 S SDRRDOW=$O(^SC(SDRRIEN,"T"_SDRRI,SDRRST)) Q:SDRRDOW S:SDRRDOW SDRRNOAV=1
I SDRRNOAV Q 0 ; No future dates available
I '$D(SDRRYEAR) N SDRRYEAR D YEAR
S SDRRHOL=($P($G(^SC(SDRRIEN,"SL")),U,8)="Y")
S SDRRTOT=0,SDRRDT=SDRRST
F S SDRRDT=$O(SDRRYEAR(SDRRDT)) Q:SDRRDT>SDRRND!'SDRRDT D
. I 'SDRRHOL,$P(SDRRYEAR(SDRRDT),U,2) Q
. S SDRRTPDT=$G(^SC(SDRRIEN,"ST",SDRRDT,1)) ; Pattern
. I SDRRTPDT="" D Q:SDRRTPDT=""
. . S SDRRT="T"_+SDRRYEAR(SDRRDT)
. . S SDRRTPT=$O(^SC(SDRRIEN,SDRRT,SDRRDT)) Q:SDRRTPT=""
. . S SDRRTPDT=$G(^SC(SDRRIEN,SDRRT,SDRRTPT,1))
. S SDRRTOT=SDRRTOT+$$AVAIL(SDRRTPDT)
Q SDRRTOT
AVAIL(SDRRPAT) ; Given pattern, returns number of available slots.
; Check the pattern for available slots
; 0-9 and j-z = available slots where j=10, k=11...z=26
; $A(1)=49 $A(9)=57 $A("j")=106 $A("z")=122
N SDRRCNT,SDRRCHAR,I
S SDRRCNT=0
S SDRRPAT=$TR($E(SDRRPAT,6,$L(SDRRPAT)),"|[] ","")
F I=1:1:$L(SDRRPAT) S SDRRCHAR=$A(SDRRPAT,I) D
. I SDRRCHAR>48,SDRRCHAR<58 S SDRRCNT=SDRRCNT+$C(SDRRCHAR) Q
. I SDRRCHAR>105,SDRRCHAR<123 S SDRRCNT=SDRRCNT+SDRRCHAR-96
Q SDRRCNT
YEAR ; Set-up 1 year dates
; This array is used for available appointments
N SDRRI,SDRRDT
S SDRRDT=SDRRST
F SDRRI=1:1:365 D Q:SDRRDT=SDRRND
. S SDRRDT=$$FMADD^XLFDT(SDRRDT,1)
. S SDRRYEAR(SDRRDT)=$$DOW^XLFDT(SDRRDT,1)
. I $D(^HOLIDAY(SDRRDT)) S $P(SDRRYEAR(SDRRDT),U,2)=1
Q
DELETE ; This entry point is invoked by the new style xref A66201 on the .01 field of file 403.5
I $D(SDRRDA),$D(APPT),$D(CLIN1) D Q
.D DELAPPT(SDRRDA,APPT,CLIN1)
D DELUSER(DA)
Q
DELAPPT(SDRRIEN,APPT,CLIN1) ; Record deleted from Recall List because of appointment.
N SDRRFDA
S SDRRFDA(403.56,"+1,",101)=APPT ; appt date
S SDRRFDA(403.56,"+1,",102)=CLIN1 ; appt clinic
D DELSET(SDRRIEN,.SDRRFDA)
Q
DELUSER(SDRRIEN) ; Record deleted by a user.
N SDRRFDA
S SDRRFDA(403.56,"+1,",201)=$E($$NOW^XLFDT(),1,12) ; delete date
S SDRRFDA(403.56,"+1,",202)=DUZ ; delete clerk
S:$G(SDRRFTR) SDRRFDA(403.56,"+1,",203)=SDRRFTR ; delete reason:
D DELSET(SDRRIEN,.SDRRFDA)
Q
DELSET(SDRRIEN,SDRRFDA) ;
N SDRRREC
S SDRRREC=$G(^SD(403.5,SDRRIEN,0))
S SDRRFDA(403.56,"+1,",.01)=$P(SDRRREC,U,1) ; patient
S SDRRFDA(403.56,"+1,",2)=$P(SDRRREC,U,3) ; accession #
S SDRRFDA(403.56,"+1,",2.5)=$P(SDRRREC,U,7) ; comment
S SDRRFDA(403.56,"+1,",2.6)=$P(SDRRREC,U,8) ; fast / non-fast
S SDRRFDA(403.56,"+1,",3)=$P(SDRRREC,U,4) ; test/app.
S SDRRFDA(403.56,"+1,",4)=$P(SDRRREC,U,5) ; provider
S SDRRFDA(403.56,"+1,",4.5)=$P(SDRRREC,U,2) ; clinic
S SDRRFDA(403.56,"+1,",4.7)=$P(SDRRREC,U,9) ; length of appt.
S SDRRFDA(403.56,"+1,",5)=$P(SDRRREC,U,6) ; recall date
S SDRRFDA(403.56,"+1,",6)=$P(SDRRREC,U,10) ; date reminder sent
S SDRRFDA(403.56,"+1,",7)=$P(SDRRREC,U,11) ; user who entered recall
D UPDATE^DIE("","SDRRFDA")
Q
SDRRISRU ;10N20/MAH;Recall Reminder Utilities ;01/18/2008 11:32
+1 ;;5.3;PIMS;**1016**;JUN 30, 2012;Build 20
OPENSLOT(SDRRIEN,SDRRST,SDRRND) ; Function returns the number of open (available)
+1 ; slots at the clinic during the time period.
+2 ; SDRRIEN - IEN of clinic in file #44
+3 ; SDRRST - (optional) start checking on this date (default=today)
+4 ; SDRRND - (optional) end of time period (default=last day of month)
+5 NEW SDRRNOAV,SDRRTOT,SDRRHOL,SDRRT,SDRRTPT,SDRRTPDT,SDRRDT,SDRRDA
+6 NEW SDRRFTR,CK,CLIN1,DA,DFN
+7 IF '$DATA(SDRRST)
SET SDRRST=DT
+8 ; end of month
IF '$DATA(SDRRND)
Begin DoDot:1
+9 SET SDRRND=$EXTRACT($$SCH^XLFDT("1M(L)",SDRRST),1,7)
+10 SET SDRRND=$$FMADD^XLFDT(SDRRND,1)
+11 IF $EXTRACT(SDRRST,1,5)=$EXTRACT(SDRRND,1,5)
QUIT
+12 SET SDRRND=$$FMADD^XLFDT($EXTRACT(SDRRND,1,5)_"01",-1)
End DoDot:1
+13 SET SDRRST=$$FMADD^XLFDT(SDRRST,-1)
+14 SET SDRRNOAV=0
+15 IF '$ORDER(^SC(SDRRIEN,"OST",SDRRST))
IF '$ORDER(^SC(SDRRIEN,"ST",SDRRST,0))
Begin DoDot:1
+16 NEW SDRRI,SDRRDOW
+17 FOR SDRRI=0:1:6
SET SDRRDOW=$ORDER(^SC(SDRRIEN,"T"_SDRRI,SDRRST))
IF SDRRDOW
QUIT
IF SDRRDOW
SET SDRRNOAV=1
End DoDot:1
+18 ; No future dates available
IF SDRRNOAV
QUIT 0
+19 IF '$DATA(SDRRYEAR)
NEW SDRRYEAR
DO YEAR
+20 SET SDRRHOL=($PIECE($GET(^SC(SDRRIEN,"SL")),U,8)="Y")
+21 SET SDRRTOT=0
SET SDRRDT=SDRRST
+22 FOR
SET SDRRDT=$ORDER(SDRRYEAR(SDRRDT))
IF SDRRDT>SDRRND!'SDRRDT
QUIT
Begin DoDot:1
+23 IF 'SDRRHOL
IF $PIECE(SDRRYEAR(SDRRDT),U,2)
QUIT
+24 ; Pattern
SET SDRRTPDT=$GET(^SC(SDRRIEN,"ST",SDRRDT,1))
+25 IF SDRRTPDT=""
Begin DoDot:2
+26 SET SDRRT="T"_+SDRRYEAR(SDRRDT)
+27 SET SDRRTPT=$ORDER(^SC(SDRRIEN,SDRRT,SDRRDT))
IF SDRRTPT=""
QUIT
+28 SET SDRRTPDT=$GET(^SC(SDRRIEN,SDRRT,SDRRTPT,1))
End DoDot:2
IF SDRRTPDT=""
QUIT
+29 SET SDRRTOT=SDRRTOT+$$AVAIL(SDRRTPDT)
End DoDot:1
+30 QUIT SDRRTOT
AVAIL(SDRRPAT) ; Given pattern, returns number of available slots.
+1 ; Check the pattern for available slots
+2 ; 0-9 and j-z = available slots where j=10, k=11...z=26
+3 ; $A(1)=49 $A(9)=57 $A("j")=106 $A("z")=122
+4 NEW SDRRCNT,SDRRCHAR,I
+5 SET SDRRCNT=0
+6 SET SDRRPAT=$TRANSLATE($EXTRACT(SDRRPAT,6,$LENGTH(SDRRPAT)),"|[] ","")
+7 FOR I=1:1:$LENGTH(SDRRPAT)
SET SDRRCHAR=$ASCII(SDRRPAT,I)
Begin DoDot:1
+8 IF SDRRCHAR>48
IF SDRRCHAR<58
SET SDRRCNT=SDRRCNT+$CHAR(SDRRCHAR)
QUIT
+9 IF SDRRCHAR>105
IF SDRRCHAR<123
SET SDRRCNT=SDRRCNT+SDRRCHAR-96
End DoDot:1
+10 QUIT SDRRCNT
YEAR ; Set-up 1 year dates
+1 ; This array is used for available appointments
+2 NEW SDRRI,SDRRDT
+3 SET SDRRDT=SDRRST
+4 FOR SDRRI=1:1:365
Begin DoDot:1
+5 SET SDRRDT=$$FMADD^XLFDT(SDRRDT,1)
+6 SET SDRRYEAR(SDRRDT)=$$DOW^XLFDT(SDRRDT,1)
+7 IF $DATA(^HOLIDAY(SDRRDT))
SET $PIECE(SDRRYEAR(SDRRDT),U,2)=1
End DoDot:1
IF SDRRDT=SDRRND
QUIT
+8 QUIT
DELETE ; This entry point is invoked by the new style xref A66201 on the .01 field of file 403.5
+1 IF $DATA(SDRRDA)
IF $DATA(APPT)
IF $DATA(CLIN1)
Begin DoDot:1
+2 DO DELAPPT(SDRRDA,APPT,CLIN1)
End DoDot:1
QUIT
+3 DO DELUSER(DA)
+4 QUIT
DELAPPT(SDRRIEN,APPT,CLIN1) ; Record deleted from Recall List because of appointment.
+1 NEW SDRRFDA
+2 ; appt date
SET SDRRFDA(403.56,"+1,",101)=APPT
+3 ; appt clinic
SET SDRRFDA(403.56,"+1,",102)=CLIN1
+4 DO DELSET(SDRRIEN,.SDRRFDA)
+5 QUIT
DELUSER(SDRRIEN) ; Record deleted by a user.
+1 NEW SDRRFDA
+2 ; delete date
SET SDRRFDA(403.56,"+1,",201)=$EXTRACT($$NOW^XLFDT(),1,12)
+3 ; delete clerk
SET SDRRFDA(403.56,"+1,",202)=DUZ
+4 ; delete reason:
IF $GET(SDRRFTR)
SET SDRRFDA(403.56,"+1,",203)=SDRRFTR
+5 DO DELSET(SDRRIEN,.SDRRFDA)
+6 QUIT
DELSET(SDRRIEN,SDRRFDA) ;
+1 NEW SDRRREC
+2 SET SDRRREC=$GET(^SD(403.5,SDRRIEN,0))
+3 ; patient
SET SDRRFDA(403.56,"+1,",.01)=$PIECE(SDRRREC,U,1)
+4 ; accession #
SET SDRRFDA(403.56,"+1,",2)=$PIECE(SDRRREC,U,3)
+5 ; comment
SET SDRRFDA(403.56,"+1,",2.5)=$PIECE(SDRRREC,U,7)
+6 ; fast / non-fast
SET SDRRFDA(403.56,"+1,",2.6)=$PIECE(SDRRREC,U,8)
+7 ; test/app.
SET SDRRFDA(403.56,"+1,",3)=$PIECE(SDRRREC,U,4)
+8 ; provider
SET SDRRFDA(403.56,"+1,",4)=$PIECE(SDRRREC,U,5)
+9 ; clinic
SET SDRRFDA(403.56,"+1,",4.5)=$PIECE(SDRRREC,U,2)
+10 ; length of appt.
SET SDRRFDA(403.56,"+1,",4.7)=$PIECE(SDRRREC,U,9)
+11 ; recall date
SET SDRRFDA(403.56,"+1,",5)=$PIECE(SDRRREC,U,6)
+12 ; date reminder sent
SET SDRRFDA(403.56,"+1,",6)=$PIECE(SDRRREC,U,10)
+13 ; user who entered recall
SET SDRRFDA(403.56,"+1,",7)=$PIECE(SDRRREC,U,11)
+14 DO UPDATE^DIE("","SDRRFDA")
+15 QUIT
