- 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
