SDEC54A ;ALB/SAT - VISTA SCHEDULING RPCS ;JUL 26, 2017
;;5.3;Scheduling;**627,642,658,665,672**;Aug 13, 1993;Build 9
;
Q
;
SUMMAGET(SDECY,SDBEG,SDEND,USER,LSUB,MAXREC) ;get ALL appointments with a cancel status from SDEC APPOINTMENT for given date range and user
;SUMMAGET(SDECY,SDBEG,SDEND,USER) external parameter tag is in SDEC
;INPUT:
; SDBEG = (optional) Filter Begin Date in external form; default to all dates
; SDEND = (optional) Filter End Date in external form; default to all dates
; USER = (optional) pointer to new person file - used to filter by user
; LSUB = (optional) subscripts from previous call
; MAXREC = (optional) Max records to return
;RETURN:
; global array in which each array entry contains data from the SDEC APPOINTMENT file
; each entry contains the following ^ pieces:
; 1. APPT - Pointer to SDEC APPOINTMENT file
; 2. DATE - Appointment Start time in external format from STARTTIME field of SDEC APPOINTMENT file
; 3. IEN - patient pointer to PATIENT file
; 4. NAME - patient name from PATIENT file
; 5. CLINIEN - Clinic pointer to HOSPITAL LOCATION file
; 6. CLINNAME - Clinic name from HOSPITAL LOCATION file
; 7. DATE1 - Cancel Date/Time in external format from CANCEL DATETIME field
; 8. USERIEN - DATA ENTRY CLERK ien pointer to NEW PERSON file
; 9. USERNAME - DATA ENTRY CLERK name from NEW PERSON file
; 10. PROVIEN - Provider ien from PROVIDER field pointer to NEW PERSON file
; 11. PROVNAME - provider name of PROVIDER from NEW PERSON file
; 12. STATUS - text from STATUS field valid values are:
; CANCELLED BY CLINIC & AUTO RE-BOOK
; CANCELLED BY PATIENT
; CANCELLED BY PATIENT & AUTO-REBOOK
; 13. EESTAT - Patient Status N=NEW E=ESTABLISHED
; 14. LASTSUB - Last referenced subscripts used to pass into next call
; 15. NUMBER - This record is NUMBER ## of TOTAL
; 16. TOTAL - total number of records returned. Only the last record will contain this data piece
; This number will accumulate with multiple calls if LSUB is passed in.
N DATE,DATE1,X,Y,%DT
N SDECI,SDCLIN,SDI,SDJ,SDNOD,SDRES,SDSTAT,SDSUB,SDTMP,SDTOT
S SDSUB=""
S SDECY="^TMP(""SDEC54"","_$J_",""SUMMAGET"")"
K @SDECY
S SDECI=0
; 1 2 3 4 5 6
S SDTMP="T00030APPT^T00030DATE^T00030IEN^T00030NAME^T00030CLINIEN^T00030CLINNAME"
; 7 8 9 10 11
S SDTMP=SDTMP_"^T00030DATE1^T00030USERIEN^T00030USERNAME^T00030PROVIEN^T00030PROVNAME"
; 12 13 14 15 16
S SDTMP=SDTMP_"^T00030STATUS^T00030EESTAT^T00030LASTSUB^T00030NUMBER^T00030TOTAL"
S @SDECY@(SDECI)=SDTMP_$C(30)
;check begin date (optional)
I $G(SDBEG)'="" S %DT="" S X=$P($G(SDBEG),"@",1) D ^%DT S SDBEG=Y I Y=-1 S SDBEG=1410102 ;alb/sat 658 use valid FM range instead of 1000101
I $G(SDBEG)="" S SDBEG=1410102 ;alb/sat 658 use valid FM range instead of 1000101
;check end date (optional)
I $G(SDEND)'="" S %DT="" S X=$P($G(SDEND),"@",1) D ^%DT S SDEND=Y I Y=-1 S SDEND=4141015 ;alb/sat 658 use valid FM range instead of 9991231
I $G(SDEND)="" S SDEND=4141015 ;alb/sat 658 use valid FM range instead of 9991231
;check user
S USER=$G(USER)
I '$D(^VA(200,+USER,0)) S USER=""
;check LSUB <TYPE> | <SUBSCRIPT [ <SUBSCRIPT> ...
S LSUB=$G(LSUB)
S SDTOT=+$P(LSUB,"|",1)
;check MAXREC
S MAXREC=$G(MAXREC) S:'+MAXREC MAXREC=100
;
S SDJ=$S($P(LSUB,"|",2)'="":$P(LSUB,"|",2)-.0001,1:SDBEG)
F S SDJ=$O(^SDEC(409.84,"AD",SDJ)) Q:SDJ'>0 Q:SDJ="" Q:$P(SDJ,".",1)>$P(SDEND,".",1) D I SDECI'<MAXREC S:SDSUB="" SDSUB=(SDTOT+SDECI)_"|"_SDJ_"|"_SDI Q
.S SDI=$S($P(LSUB,"|",3)'="":$P(LSUB,"|",3),1:"")
.S LSUB=""
.F S SDI=$O(^SDEC(409.84,"AD",SDJ,SDI)) Q:SDI'>0 D I SDECI'<MAXREC S:SDSUB="" SDSUB=(SDTOT+SDECI)_"|"_SDJ_"|"_SDI Q
..S SDNOD=$G(^SDEC(409.84,SDI,0))
..;get/check status
..S SDSTAT=$P(SDNOD,U,17)
..S SDSTAT=$S(SDSTAT="C":"CANCELLED BY CLINIC",SDSTAT="CA":"CANCELLED BY CLINIC & AUTO RE-BOOK",SDSTAT="PC":"CANCELLED BY PATIENT",SDSTAT="PCA":"CANCELLED BY PATIENT & AUTO-REBOOK",1:"")
..S:SDSTAT="" SDSTAT=$S(SDSTAT="N":"NO-SHOW",SDSTAT="NA":"NO-SHOW & AUTO RE-BOOK",SDSTAT="I":"INPATIENT APPOINTMENT",1:"NO ACTION TAKEN")
..Q:SDSTAT=""
..;Q:'$$CKDT($P(SDNOD,U,1),SDBEG,SDEND)
..I +USER Q:$P(SDNOD,U,21)'=USER ;compare USER to cancelled by ;alb/sat 658 - use CANCELLED BY USER instead of DATA ENTRY CLERK
..;get clinic via resource
..S SDRES=$P(SDNOD,U,7)
..S SDCLIN=$P($G(^SDEC(409.831,+SDRES,0)),U,4)
..S DATE=$$FMTE^XLFDT($P(SDNOD,U,1)) ;STARTTIME
..S DATE1=$$FMTE^XLFDT($P(SDNOD,U,12))
..; 1 2 3 4
..S SDTMP=SDI_U_DATE_U_$P(SDNOD,U,5)_U_$$GET1^DIQ(2,$P(SDNOD,U,5)_",",.01)
..; 5 6 7
..S SDTMP=SDTMP_U_SDCLIN_U_$$GET1^DIQ(44,SDCLIN_",",.01)_U_DATE1
..; 8 9
..S SDTMP=SDTMP_U_$P(SDNOD,U,21)_U_$$GET1^DIQ(200,$P(SDNOD,U,21)_",",.01) ;;alb/sat 658 - use CANCELLED BY USER [21] instead of DATA ENTRY CLERK [8]
..; 10 11 12 13
..S SDTMP=SDTMP_U_$P(SDNOD,U,16)_U_$$GET1^DIQ(200,$P(SDNOD,U,16)_",",.01)_U_SDSTAT_U_$$GET1^DIQ(409.84,SDI_",",.23,"E")
..; 14 15
..S SDTMP=SDTMP_U_""_U_(SDTOT+SDECI+1)
..S SDECI=SDECI+1 S @SDECY@(SDECI)=SDTMP_$C(30)
I SDECI>0 S SDTMP=$P(@SDECY@(SDECI),$C(30),1) S $P(SDTMP,U,16)=(SDTOT+SDECI) S:SDSUB'="" $P(SDTMP,U,14)=SDSUB S @SDECY@(SDECI)=SDTMP_$C(30)
S @SDECY@(SDECI)=@SDECY@(SDECI)_$C(31)
Q
;
CKDT(DATE,BEG,END) ;check date range
;RETURN
; 0=out of range
; 1=in range
N X,Y,%DT
I $G(BEG)="",$G(END)="" Q 1
I $G(DATE)="" Q 1
S %DT="T" S X=$P(DATE,"@",1) D ^%DT S DATE=Y
I DATE=-1 Q 0
Q:DATE<BEG 0
Q:DATE>END 0
Q 1
;
APPO(APPO,SDBEG,SDEND,USER) ;get appointments for date range and user ;alb/sat 642
N SDCNT,SDI,SDJ,SDNOD,SDNOD2,SDTYP,SDTYPID
K APPO
S USER=$G(USER)
S SDI=SDBEG-1 F S SDI=$O(^SDEC(409.84,"AC",SDI)) Q:SDI="" Q:SDI>SDEND D
.S SDJ="" F S SDJ=$O(^SDEC(409.84,"AC",SDI,SDJ)) Q:SDJ="" D
..S SDNOD=$G(^SDEC(409.84,SDJ,0))
..I +USER,$P(SDNOD,U,8)'=USER Q ;check user match
..Q:($P(SDNOD,U,12)'="")!($P(SDNOD,U,23)'="") ;don't include cancel or no-show
..S SDNOD2=$G(^SDEC(409.84,SDJ,2))
..S SDTYPID=$P($P(SDNOD2,U,1),";",1)
..S SDTYP=$P($P(SDNOD2,U,1),";",2) S SDTYP=$S(SDTYP="SDEC(409.85,":"A",SDTYP="GMR(123,":"C",SDTYP="SDWL(409.3,":"E",SDTYP="SD(403.5,":"R",1:"")
..Q:SDTYP=""
..S (SDCNT,APPO(SDTYP,$P(SDNOD,U,9),$P(SDNOD,U,8)))=$G(APPO(SDTYP,$P(SDNOD,U,9),$P(SDNOD,U,8)))+1
..S APPO(SDTYP,$P(SDNOD,U,9),$P(SDNOD,U,8),SDCNT)=SDTYPID
Q
;
APPTPC(SDEC54,SDECRET,SDTOT,SDBEG,SDEND,USER,MAXREC,LSUB,SDSUB) ;get APPT patient contacts ;alb/sat 642
N PARENT,SDARR,SDID,SDIEN,SDATA,SDECY,SDPC,SDT,SDTMP,SDU
S SDEC54=$G(SDEC54,0)
Q:$G(SDECRET)=""
S SDTOT=$G(SDTOT,0)
S SDBEG=$P($G(SDBEG),".",1) S:SDBEG="" SDBEG=1410102 ;alb/sat 658 use valid FM range instead of 1000101
S SDEND=$P($G(SDEND),".",1) S:SDEND="" SDEND=4141015 ;alb/sat 658 use valid FM range instead of 9991231
S USER=$G(USER)
S SDT=$S($P(LSUB,"|",3)'="":$P(LSUB,"|",3),1:$P(SDBEG,".",1))
F S SDT=$O(^SDEC(409.85,"AD",SDT)) Q:SDT="" Q:$P(SDT,".",1)>$P(SDEND,".",1) D I SDEC54'<MAXREC S:SDSUB="" SDSUB=(SDTOT+SDEC54)_"|APPTPC|"_SDT_"|"_SDU_"|"_SDIEN Q ;alb/sat 672 - check end of date range
.S SDU=$S($P(LSUB,"|",4)'="":$P(LSUB,"|",4),1:$S(USER'="":USER-1,1:0))
.F S SDU=$O(^SDEC(409.85,"AD",SDT,SDU)) Q:SDU="" Q:(USER'="")&(SDU'=USER) D I SDEC54'<MAXREC S:SDSUB="" SDSUB=(SDTOT+SDEC54)_"|APPTPC|"_SDT_"|"_SDU_"|"_SDIEN Q
..S SDIEN=$S($P(LSUB,"|",5)'="":$P(LSUB,"|",5),1:"")
..F S SDIEN=$O(^SDEC(409.85,"AD",SDT,SDU,SDIEN)) Q:SDIEN="" D I SDEC54'<MAXREC S:SDSUB="" SDSUB=(SDTOT+SDEC54)_"|APPTPC|"_SDT_"|"_SDU_"|"_SDIEN Q
...Q:$D(SDARR(SDIEN))
...S SDARR(SDIEN)=""
...K DATA
...D APPTPC1(.DATA,SDIEN)
...S $P(DATA,U,18)=(SDTOT+SDEC54+1)
...S SDEC54=SDEC54+1 S @SDECRET@(SDEC54)=DATA_$C(30)
K SDARR ;alb/sat 672 - moved here instead of APPTPC1
Q
APPTPC1(DATA,SDIEN) ;alb/sat 665 - split APPTPC1 out of APPTPC
N PARENT,SDATA,SDECY,SDPC
D ARGET^SDEC(.SDECY,SDIEN)
Q:$G(@SDECY@(1))=""
S SDATA=@SDECY@(1)
S SDATA=$P(SDATA,$C(30),1)
S PARENT=$S($P(SDATA,U,66)'="":1,$P(SDATA,U,67)=$P(SDATA,U,7):1,1:0)
S SDPC=$$SDPC($P(SDATA,U,33))
; 1 2 3 4 5 6
S DATA="APPT"_U_$P(SDATA,U,1)_U_$P(SDATA,U,2)_U_U_$P(SDATA,U,14)_U_$P(SDATA,U,15)
; 7 8 9 10 11
S DATA=DATA_U_$P(SDATA,U,34)_U_$P(SDATA,U,35)_U_$P(SDATA,U,36)_U_SDPC_U_""
; 16 18
S DATA=DATA_U_U_U_U_U_SDIEN_U_U_U_U_PARENT
K @SDECY
Q
;
SDPC(SDPC,SDU) ;return patient contact entries for given user
N SDI,SDNOD,SDRET,SDUSER
S SDPC=$G(SDPC)
S SDU=$G(SDU)
S SDRET=""
Q:SDU="" SDPC
F SDI=1:1:$L(SDPC,"::") D
.S SDNOD=$P(SDPC,"::",SDI)
.S SDUSER=$P(SDNOD,"~~",2)
.S:SDUSER=SDU SDRET=SDRET_$S(SDRET'="":"::",1:"")_SDNOD
Q SDRET
;
EWLPC(SDEC54,SDECRET,SDTOT,SDBEG,SDEND,USER,MAXREC,LSUB,SDSUB) ;get wait list patient contacts ;alb/sat 642
; .SDEC54
; SDECRET
; SDTOT
; SDBEG
; SDEND
; USER
; MAXREC
; LSUB
; .SDSUB
N SDARR,SDID,SDIEN,SDATA,SDECY,SDPC,SDT,SDTMP,SDU
S SDEC54=$G(SDEC54,0)
Q:$G(SDECRET)=""
S SDTOT=$G(SDTOT,0)
S SDBEG=$P($G(SDBEG),".",1) S:SDBEG="" SDBEG=1410102 ;alb/sat 658 use valid FM range instead of 1000101
S SDEND=$P($G(SDEND),".",1) S:SDEND="" SDEND=4141015 ;alb/sat 658 use valid FM range instead of 9991231
S USER=$G(USER)
S SDT=$S($P(LSUB,"|",3)'="":$P(LSUB,"|",3),1:(SDBEG-1)) F S SDT=$O(^SDWL(409.3,"AF",SDT)) Q:SDT="" D I SDEC54'<MAXREC S:SDSUB="" SDSUB=(SDTOT+SDEC54)_"|EWLPC|"_SDT_"|"_SDU_"|"_SDIEN Q
.S SDU=$S($P(LSUB,"|",4)'="":$P(LSUB,"|",4),1:$S(USER'="":USER-1,1:0))
.F S SDU=$O(^SDWL(409.3,"AF",SDT,SDU)) Q:SDU="" Q:(USER'="")&(SDU'=USER) D I SDEC54'<MAXREC S:SDSUB="" SDSUB=(SDTOT+SDEC54)_"|EWLPC|"_SDT_"|"_SDU_"|"_SDIEN Q
..S SDIEN=$S($P(LSUB,"|",5)'="":$P(LSUB,"|",5),1:"")
..F S SDIEN=$O(^SDWL(409.3,"AF",SDT,SDU,SDIEN)) Q:SDIEN="" D I SDEC54'<MAXREC S:SDSUB="" SDSUB=(SDTOT+SDEC54)_"|EWLPC|"_SDT_"|"_SDU_"|"_SDIEN Q
...Q:$D(SDARR(SDIEN))
...S SDARR(SDIEN)=""
...D WLGET^SDEC(.SDECY,SDIEN)
...Q:$G(@SDECY@(1))=""
...S SDATA=@SDECY@(1)
...S SDATA=$P(SDATA,$C(30),1)
...S SDPC=$$SDPC($P(SDATA,U,40))
...; 1 2 3 4 5 6
...S SDTMP="EWL"_U_$P(SDATA,U,1)_U_$P(SDATA,U,2)_U_U_$P(SDATA,U,18)_U_$P(SDATA,U,19)
...; 7 8 9 10 11
...S SDTMP=SDTMP_U_$P(SDATA,U,41)_U_$P(SDATA,U,42)_U_$P(SDATA,U,43)_U_$P(SDATA,U,40)_U_""
...; 16 18
...S SDTMP=SDTMP_U_U_U_U_U_SDIEN_U_U_(SDTOT+SDEC54+1)
...S SDEC54=SDEC54+1 S @SDECRET@(SDEC54)=SDTMP_$C(30)
...K @SDECY
K SDARR
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDEC54A 11288 printed Apr 09, 2024@21:48:28 Page 2
SDEC54A ;ALB/SAT - VISTA SCHEDULING RPCS ;JUL 26, 2017
+1 ;;5.3;Scheduling;**627,642,658,665,672**;Aug 13, 1993;Build 9
+2 ;
+3 QUIT
+4 ;
SUMMAGET(SDECY,SDBEG,SDEND,USER,LSUB,MAXREC) ;get ALL appointments with a cancel status from SDEC APPOINTMENT for given date range and user
+1 ;SUMMAGET(SDECY,SDBEG,SDEND,USER) external parameter tag is in SDEC
+2 ;INPUT:
+3 ; SDBEG = (optional) Filter Begin Date in external form; default to all dates
+4 ; SDEND = (optional) Filter End Date in external form; default to all dates
+5 ; USER = (optional) pointer to new person file - used to filter by user
+6 ; LSUB = (optional) subscripts from previous call
+7 ; MAXREC = (optional) Max records to return
+8 ;RETURN:
+9 ; global array in which each array entry contains data from the SDEC APPOINTMENT file
+10 ; each entry contains the following ^ pieces:
+11 ; 1. APPT - Pointer to SDEC APPOINTMENT file
+12 ; 2. DATE - Appointment Start time in external format from STARTTIME field of SDEC APPOINTMENT file
+13 ; 3. IEN - patient pointer to PATIENT file
+14 ; 4. NAME - patient name from PATIENT file
+15 ; 5. CLINIEN - Clinic pointer to HOSPITAL LOCATION file
+16 ; 6. CLINNAME - Clinic name from HOSPITAL LOCATION file
+17 ; 7. DATE1 - Cancel Date/Time in external format from CANCEL DATETIME field
+18 ; 8. USERIEN - DATA ENTRY CLERK ien pointer to NEW PERSON file
+19 ; 9. USERNAME - DATA ENTRY CLERK name from NEW PERSON file
+20 ; 10. PROVIEN - Provider ien from PROVIDER field pointer to NEW PERSON file
+21 ; 11. PROVNAME - provider name of PROVIDER from NEW PERSON file
+22 ; 12. STATUS - text from STATUS field valid values are:
+23 ; CANCELLED BY CLINIC & AUTO RE-BOOK
+24 ; CANCELLED BY PATIENT
+25 ; CANCELLED BY PATIENT & AUTO-REBOOK
+26 ; 13. EESTAT - Patient Status N=NEW E=ESTABLISHED
+27 ; 14. LASTSUB - Last referenced subscripts used to pass into next call
+28 ; 15. NUMBER - This record is NUMBER ## of TOTAL
+29 ; 16. TOTAL - total number of records returned. Only the last record will contain this data piece
+30 ; This number will accumulate with multiple calls if LSUB is passed in.
+31 NEW DATE,DATE1,X,Y,%DT
+32 NEW SDECI,SDCLIN,SDI,SDJ,SDNOD,SDRES,SDSTAT,SDSUB,SDTMP,SDTOT
+33 SET SDSUB=""
+34 SET SDECY="^TMP(""SDEC54"","_$JOB_",""SUMMAGET"")"
+35 KILL @SDECY
+36 SET SDECI=0
+37 ; 1 2 3 4 5 6
+38 SET SDTMP="T00030APPT^T00030DATE^T00030IEN^T00030NAME^T00030CLINIEN^T00030CLINNAME"
+39 ; 7 8 9 10 11
+40 SET SDTMP=SDTMP_"^T00030DATE1^T00030USERIEN^T00030USERNAME^T00030PROVIEN^T00030PROVNAME"
+41 ; 12 13 14 15 16
+42 SET SDTMP=SDTMP_"^T00030STATUS^T00030EESTAT^T00030LASTSUB^T00030NUMBER^T00030TOTAL"
+43 SET @SDECY@(SDECI)=SDTMP_$CHAR(30)
+44 ;check begin date (optional)
+45 ;alb/sat 658 use valid FM range instead of 1000101
IF $GET(SDBEG)'=""
SET %DT=""
SET X=$PIECE($GET(SDBEG),"@",1)
DO ^%DT
SET SDBEG=Y
IF Y=-1
SET SDBEG=1410102
+46 ;alb/sat 658 use valid FM range instead of 1000101
IF $GET(SDBEG)=""
SET SDBEG=1410102
+47 ;check end date (optional)
+48 ;alb/sat 658 use valid FM range instead of 9991231
IF $GET(SDEND)'=""
SET %DT=""
SET X=$PIECE($GET(SDEND),"@",1)
DO ^%DT
SET SDEND=Y
IF Y=-1
SET SDEND=4141015
+49 ;alb/sat 658 use valid FM range instead of 9991231
IF $GET(SDEND)=""
SET SDEND=4141015
+50 ;check user
+51 SET USER=$GET(USER)
+52 IF '$DATA(^VA(200,+USER,0))
SET USER=""
+53 ;check LSUB <TYPE> | <SUBSCRIPT [ <SUBSCRIPT> ...
+54 SET LSUB=$GET(LSUB)
+55 SET SDTOT=+$PIECE(LSUB,"|",1)
+56 ;check MAXREC
+57 SET MAXREC=$GET(MAXREC)
if '+MAXREC
SET MAXREC=100
+58 ;
+59 SET SDJ=$SELECT($PIECE(LSUB,"|",2)'="":$PIECE(LSUB,"|",2)-.0001,1:SDBEG)
+60 FOR
SET SDJ=$ORDER(^SDEC(409.84,"AD",SDJ))
if SDJ'>0
QUIT
if SDJ=""
QUIT
if $PIECE(SDJ,".",1)>$PIECE(SDEND,".",1)
QUIT
Begin DoDot:1
+61 SET SDI=$SELECT($PIECE(LSUB,"|",3)'="":$PIECE(LSUB,"|",3),1:"")
+62 SET LSUB=""
+63 FOR
SET SDI=$ORDER(^SDEC(409.84,"AD",SDJ,SDI))
if SDI'>0
QUIT
Begin DoDot:2
+64 SET SDNOD=$GET(^SDEC(409.84,SDI,0))
+65 ;get/check status
+66 SET SDSTAT=$PIECE(SDNOD,U,17)
+67 SET SDSTAT=$SELECT(SDSTAT="C":"CANCELLED BY CLINIC",SDSTAT="CA":"CANCELLED BY CLINIC & AUTO RE-BOOK",SDSTAT="PC":"CANCELLED BY PATIENT",SDSTAT="PCA":"CANCELLED BY PATIENT & AUTO-REBOOK",1:"")
+68 if SDSTAT=""
SET SDSTAT=$SELECT(SDSTAT="N":"NO-SHOW",SDSTAT="NA":"NO-SHOW & AUTO RE-BOOK",SDSTAT="I":"INPATIENT APPOINTMENT",1:"NO ACTION TAKEN")
+69 if SDSTAT=""
QUIT
+70 ;Q:'$$CKDT($P(SDNOD,U,1),SDBEG,SDEND)
+71 ;compare USER to cancelled by ;alb/sat 658 - use CANCELLED BY USER instead of DATA ENTRY CLERK
IF +USER
if $PIECE(SDNOD,U,21)'=USER
QUIT
+72 ;get clinic via resource
+73 SET SDRES=$PIECE(SDNOD,U,7)
+74 SET SDCLIN=$PIECE($GET(^SDEC(409.831,+SDRES,0)),U,4)
+75 ;STARTTIME
SET DATE=$$FMTE^XLFDT($PIECE(SDNOD,U,1))
+76 SET DATE1=$$FMTE^XLFDT($PIECE(SDNOD,U,12))
+77 ; 1 2 3 4
+78 SET SDTMP=SDI_U_DATE_U_$PIECE(SDNOD,U,5)_U_$$GET1^DIQ(2,$PIECE(SDNOD,U,5)_",",.01)
+79 ; 5 6 7
+80 SET SDTMP=SDTMP_U_SDCLIN_U_$$GET1^DIQ(44,SDCLIN_",",.01)_U_DATE1
+81 ; 8 9
+82 ;;alb/sat 658 - use CANCELLED BY USER [21] instead of DATA ENTRY CLERK [8]
SET SDTMP=SDTMP_U_$PIECE(SDNOD,U,21)_U_$$GET1^DIQ(200,$PIECE(SDNOD,U,21)_",",.01)
+83 ; 10 11 12 13
+84 SET SDTMP=SDTMP_U_$PIECE(SDNOD,U,16)_U_$$GET1^DIQ(200,$PIECE(SDNOD,U,16)_",",.01)_U_SDSTAT_U_$$GET1^DIQ(409.84,SDI_",",.23,"E")
+85 ; 14 15
+86 SET SDTMP=SDTMP_U_""_U_(SDTOT+SDECI+1)
+87 SET SDECI=SDECI+1
SET @SDECY@(SDECI)=SDTMP_$CHAR(30)
End DoDot:2
IF SDECI'<MAXREC
if SDSUB=""
SET SDSUB=(SDTOT+SDECI)_"|"_SDJ_"|"_SDI
QUIT
End DoDot:1
IF SDECI'<MAXREC
if SDSUB=""
SET SDSUB=(SDTOT+SDECI)_"|"_SDJ_"|"_SDI
QUIT
+88 IF SDECI>0
SET SDTMP=$PIECE(@SDECY@(SDECI),$CHAR(30),1)
SET $PIECE(SDTMP,U,16)=(SDTOT+SDECI)
if SDSUB'=""
SET $PIECE(SDTMP,U,14)=SDSUB
SET @SDECY@(SDECI)=SDTMP_$CHAR(30)
+89 SET @SDECY@(SDECI)=@SDECY@(SDECI)_$CHAR(31)
+90 QUIT
+91 ;
CKDT(DATE,BEG,END) ;check date range
+1 ;RETURN
+2 ; 0=out of range
+3 ; 1=in range
+4 NEW X,Y,%DT
+5 IF $GET(BEG)=""
IF $GET(END)=""
QUIT 1
+6 IF $GET(DATE)=""
QUIT 1
+7 SET %DT="T"
SET X=$PIECE(DATE,"@",1)
DO ^%DT
SET DATE=Y
+8 IF DATE=-1
QUIT 0
+9 if DATE<BEG
QUIT 0
+10 if DATE>END
QUIT 0
+11 QUIT 1
+12 ;
APPO(APPO,SDBEG,SDEND,USER) ;get appointments for date range and user ;alb/sat 642
+1 NEW SDCNT,SDI,SDJ,SDNOD,SDNOD2,SDTYP,SDTYPID
+2 KILL APPO
+3 SET USER=$GET(USER)
+4 SET SDI=SDBEG-1
FOR
SET SDI=$ORDER(^SDEC(409.84,"AC",SDI))
if SDI=""
QUIT
if SDI>SDEND
QUIT
Begin DoDot:1
+5 SET SDJ=""
FOR
SET SDJ=$ORDER(^SDEC(409.84,"AC",SDI,SDJ))
if SDJ=""
QUIT
Begin DoDot:2
+6 SET SDNOD=$GET(^SDEC(409.84,SDJ,0))
+7 ;check user match
IF +USER
IF $PIECE(SDNOD,U,8)'=USER
QUIT
+8 ;don't include cancel or no-show
if ($PIECE(SDNOD,U,12)'="")!($PIECE(SDNOD,U,23)'="")
QUIT
+9 SET SDNOD2=$GET(^SDEC(409.84,SDJ,2))
+10 SET SDTYPID=$PIECE($PIECE(SDNOD2,U,1),";",1)
+11 SET SDTYP=$PIECE($PIECE(SDNOD2,U,1),";",2)
SET SDTYP=$SELECT(SDTYP="SDEC(409.85,":"A",SDTYP="GMR(123,":"C",SDTYP="SDWL(409.3,":"E",SDTYP="SD(403.5,":"R",1:"")
+12 if SDTYP=""
QUIT
+13 SET (SDCNT,APPO(SDTYP,$PIECE(SDNOD,U,9),$PIECE(SDNOD,U,8)))=$GET(APPO(SDTYP,$PIECE(SDNOD,U,9),$PIECE(SDNOD,U,8)))+1
+14 SET APPO(SDTYP,$PIECE(SDNOD,U,9),$PIECE(SDNOD,U,8),SDCNT)=SDTYPID
End DoDot:2
End DoDot:1
+15 QUIT
+16 ;
APPTPC(SDEC54,SDECRET,SDTOT,SDBEG,SDEND,USER,MAXREC,LSUB,SDSUB) ;get APPT patient contacts ;alb/sat 642
+1 NEW PARENT,SDARR,SDID,SDIEN,SDATA,SDECY,SDPC,SDT,SDTMP,SDU
+2 SET SDEC54=$GET(SDEC54,0)
+3 if $GET(SDECRET)=""
QUIT
+4 SET SDTOT=$GET(SDTOT,0)
+5 ;alb/sat 658 use valid FM range instead of 1000101
SET SDBEG=$PIECE($GET(SDBEG),".",1)
if SDBEG=""
SET SDBEG=1410102
+6 ;alb/sat 658 use valid FM range instead of 9991231
SET SDEND=$PIECE($GET(SDEND),".",1)
if SDEND=""
SET SDEND=4141015
+7 SET USER=$GET(USER)
+8 SET SDT=$SELECT($PIECE(LSUB,"|",3)'="":$PIECE(LSUB,"|",3),1:$PIECE(SDBEG,".",1))
+9 ;alb/sat 672 - check end of date range
FOR
SET SDT=$ORDER(^SDEC(409.85,"AD",SDT))
if SDT=""
QUIT
if $PIECE(SDT,".",1)>$PIECE(SDEND,".",1)
QUIT
Begin DoDot:1
+10 SET SDU=$SELECT($PIECE(LSUB,"|",4)'="":$PIECE(LSUB,"|",4),1:$SELECT(USER'="":USER-1,1:0))
+11 FOR
SET SDU=$ORDER(^SDEC(409.85,"AD",SDT,SDU))
if SDU=""
QUIT
if (USER'="")&(SDU'=USER)
QUIT
Begin DoDot:2
+12 SET SDIEN=$SELECT($PIECE(LSUB,"|",5)'="":$PIECE(LSUB,"|",5),1:"")
+13 FOR
SET SDIEN=$ORDER(^SDEC(409.85,"AD",SDT,SDU,SDIEN))
if SDIEN=""
QUIT
Begin DoDot:3
+14 if $DATA(SDARR(SDIEN))
QUIT
+15 SET SDARR(SDIEN)=""
+16 KILL DATA
+17 DO APPTPC1(.DATA,SDIEN)
+18 SET $PIECE(DATA,U,18)=(SDTOT+SDEC54+1)
+19 SET SDEC54=SDEC54+1
SET @SDECRET@(SDEC54)=DATA_$CHAR(30)
End DoDot:3
IF SDEC54'<MAXREC
if SDSUB=""
SET SDSUB=(SDTOT+SDEC54)_"|APPTPC|"_SDT_"|"_SDU_"|"_SDIEN
QUIT
End DoDot:2
IF SDEC54'<MAXREC
if SDSUB=""
SET SDSUB=(SDTOT+SDEC54)_"|APPTPC|"_SDT_"|"_SDU_"|"_SDIEN
QUIT
End DoDot:1
IF SDEC54'<MAXREC
if SDSUB=""
SET SDSUB=(SDTOT+SDEC54)_"|APPTPC|"_SDT_"|"_SDU_"|"_SDIEN
QUIT
+20 ;alb/sat 672 - moved here instead of APPTPC1
KILL SDARR
+21 QUIT
APPTPC1(DATA,SDIEN) ;alb/sat 665 - split APPTPC1 out of APPTPC
+1 NEW PARENT,SDATA,SDECY,SDPC
+2 DO ARGET^SDEC(.SDECY,SDIEN)
+3 if $GET(@SDECY@(1))=""
QUIT
+4 SET SDATA=@SDECY@(1)
+5 SET SDATA=$PIECE(SDATA,$CHAR(30),1)
+6 SET PARENT=$SELECT($PIECE(SDATA,U,66)'="":1,$PIECE(SDATA,U,67)=$PIECE(SDATA,U,7):1,1:0)
+7 SET SDPC=$$SDPC($PIECE(SDATA,U,33))
+8 ; 1 2 3 4 5 6
+9 SET DATA="APPT"_U_$PIECE(SDATA,U,1)_U_$PIECE(SDATA,U,2)_U_U_$PIECE(SDATA,U,14)_U_$PIECE(SDATA,U,15)
+10 ; 7 8 9 10 11
+11 SET DATA=DATA_U_$PIECE(SDATA,U,34)_U_$PIECE(SDATA,U,35)_U_$PIECE(SDATA,U,36)_U_SDPC_U_""
+12 ; 16 18
+13 SET DATA=DATA_U_U_U_U_U_SDIEN_U_U_U_U_PARENT
+14 KILL @SDECY
+15 QUIT
+16 ;
SDPC(SDPC,SDU) ;return patient contact entries for given user
+1 NEW SDI,SDNOD,SDRET,SDUSER
+2 SET SDPC=$GET(SDPC)
+3 SET SDU=$GET(SDU)
+4 SET SDRET=""
+5 if SDU=""
QUIT SDPC
+6 FOR SDI=1:1:$LENGTH(SDPC,"::")
Begin DoDot:1
+7 SET SDNOD=$PIECE(SDPC,"::",SDI)
+8 SET SDUSER=$PIECE(SDNOD,"~~",2)
+9 if SDUSER=SDU
SET SDRET=SDRET_$SELECT(SDRET'="":"::",1:"")_SDNOD
End DoDot:1
+10 QUIT SDRET
+11 ;
EWLPC(SDEC54,SDECRET,SDTOT,SDBEG,SDEND,USER,MAXREC,LSUB,SDSUB) ;get wait list patient contacts ;alb/sat 642
+1 ; .SDEC54
+2 ; SDECRET
+3 ; SDTOT
+4 ; SDBEG
+5 ; SDEND
+6 ; USER
+7 ; MAXREC
+8 ; LSUB
+9 ; .SDSUB
+10 NEW SDARR,SDID,SDIEN,SDATA,SDECY,SDPC,SDT,SDTMP,SDU
+11 SET SDEC54=$GET(SDEC54,0)
+12 if $GET(SDECRET)=""
QUIT
+13 SET SDTOT=$GET(SDTOT,0)
+14 ;alb/sat 658 use valid FM range instead of 1000101
SET SDBEG=$PIECE($GET(SDBEG),".",1)
if SDBEG=""
SET SDBEG=1410102
+15 ;alb/sat 658 use valid FM range instead of 9991231
SET SDEND=$PIECE($GET(SDEND),".",1)
if SDEND=""
SET SDEND=4141015
+16 SET USER=$GET(USER)
+17 SET SDT=$SELECT($PIECE(LSUB,"|",3)'="":$PIECE(LSUB,"|",3),1:(SDBEG-1))
FOR
SET SDT=$ORDER(^SDWL(409.3,"AF",SDT))
if SDT=""
QUIT
Begin DoDot:1
+18 SET SDU=$SELECT($PIECE(LSUB,"|",4)'="":$PIECE(LSUB,"|",4),1:$SELECT(USER'="":USER-1,1:0))
+19 FOR
SET SDU=$ORDER(^SDWL(409.3,"AF",SDT,SDU))
if SDU=""
QUIT
if (USER'="")&(SDU'=USER)
QUIT
Begin DoDot:2
+20 SET SDIEN=$SELECT($PIECE(LSUB,"|",5)'="":$PIECE(LSUB,"|",5),1:"")
+21 FOR
SET SDIEN=$ORDER(^SDWL(409.3,"AF",SDT,SDU,SDIEN))
if SDIEN=""
QUIT
Begin DoDot:3
+22 if $DATA(SDARR(SDIEN))
QUIT
+23 SET SDARR(SDIEN)=""
+24 DO WLGET^SDEC(.SDECY,SDIEN)
+25 if $GET(@SDECY@(1))=""
QUIT
+26 SET SDATA=@SDECY@(1)
+27 SET SDATA=$PIECE(SDATA,$CHAR(30),1)
+28 SET SDPC=$$SDPC($PIECE(SDATA,U,40))
+29 ; 1 2 3 4 5 6
+30 SET SDTMP="EWL"_U_$PIECE(SDATA,U,1)_U_$PIECE(SDATA,U,2)_U_U_$PIECE(SDATA,U,18)_U_$PIECE(SDATA,U,19)
+31 ; 7 8 9 10 11
+32 SET SDTMP=SDTMP_U_$PIECE(SDATA,U,41)_U_$PIECE(SDATA,U,42)_U_$PIECE(SDATA,U,43)_U_$PIECE(SDATA,U,40)_U_""
+33 ; 16 18
+34 SET SDTMP=SDTMP_U_U_U_U_U_SDIEN_U_U_(SDTOT+SDEC54+1)
+35 SET SDEC54=SDEC54+1
SET @SDECRET@(SDEC54)=SDTMP_$CHAR(30)
+36 KILL @SDECY
End DoDot:3
IF SDEC54'<MAXREC
if SDSUB=""
SET SDSUB=(SDTOT+SDEC54)_"|EWLPC|"_SDT_"|"_SDU_"|"_SDIEN
QUIT
End DoDot:2
IF SDEC54'<MAXREC
if SDSUB=""
SET SDSUB=(SDTOT+SDEC54)_"|EWLPC|"_SDT_"|"_SDU_"|"_SDIEN
QUIT
End DoDot:1
IF SDEC54'<MAXREC
if SDSUB=""
SET SDSUB=(SDTOT+SDEC54)_"|EWLPC|"_SDT_"|"_SDU_"|"_SDIEN
QUIT
+37 KILL SDARR
+38 QUIT
