SDEC54 ;ALB/SAT - VISTA SCHEDULING RPCS ;JUN 21, 2017
;;5.3;Scheduling;**627,642,658,665**;Aug 13, 1993;Build 14
;
;Reference is made to ICR #6185
Q
;
;DATE RANGE FOR INPUT
SUMMGET(SDECRET,SDBEG,SDEND,USER,LSUB,MAXREC) ;GET Audit Summary for given date range
N CLOSED,COUNT,DFN,DISPDT,DISPU,FNUM,NAMEPART,PROVNAME,RET,WLDATA,WLIEN,X,Y,%DT
N APPO,ARIEN,SDDATA,SDEC54,SDECI,SDECY,SDNUM,SDTMP,SDTOT,SDDEMO,SDSUB,SDT,SDU,USER1 ;alb/sat 642 added APPO
S SDECRET="^TMP(""SDEC54"","_$J_",""SUMMGET"")"
K @SDECRET
S SDSUB=""
S SDEC54=0
; 1 2 3 4 5 6
S SDTMP="T00030REQUESTTYPE^T00030DFN^T00030NAME^T00030DATE^T00030USERIEN^T00030USERNAME"
; 7 8 9 10 11
S SDTMP=SDTMP_"^T00030DATE1^T00030PROVIEN^T00030PROVNAME^T00030PCONTACT^T00030APPT_SCHED_DATE"
; 12 13 14 15
S SDTMP=SDTMP_"^T00030DATE2^T00030CLINIEN^T00030CLINNAME^T00030ACTIVITY^T00030IEN"
S SDTMP=SDTMP_"^T00030LASTSUB^T00030NUMBER^T00030TOTAL^T00030MRTC"
S @SDECRET@(SDEC54)=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 <COUNT> | <TYPE> | <SUBSCRIPT [ <SUBSCRIPT> ...
S LSUB=$G(LSUB)
S SDTOT=+$P(LSUB,"|",1)
;check MAXREC
S MAXREC=$G(MAXREC) S:'+MAXREC MAXREC=9999999 ;alb/sat 665 - remove limits
;get SDEC APPOINTMENT entries with DATE APPT MADE in date range ;alb/sat 642
D APPO^SDEC54A(.APPO,SDBEG,SDEND,USER) ;artf19425
;get SDEC APPT REQUEST data
I (LSUB="")!($P(LSUB,"|",2)="APPT") D APPT
G:SDEC54'<MAXREC XIT
I (LSUB="")!($P(LSUB,"|",2)="APPTAP") D APPTAPPS ;artf19425
G:SDEC54'<MAXREC XIT
;get patient contacts from APPT
I (LSUB="")!($P(LSUB,"|",2)="APPTPC") D APPTPC^SDEC54A(.SDEC54,SDECRET,SDTOT,SDBEG,SDEND,USER,MAXREC,LSUB,.SDSUB) ;artf19425
G:SDEC54'<MAXREC XIT ;artf19425
;get SD WAIT LIST data
I (LSUB="")!($P(LSUB,"|",2)="EWL") D EWL
G:SDEC54'<MAXREC XIT
I (LSUB="")!($P(LSUB,"|",2)="WLAP") D WLAPPS ;artf19425
G:SDEC54'<MAXREC XIT
;get patient contacts from wait list
I (LSUB="")!($P(LSUB,"|",2)="EWLPC") D EWLPC^SDEC54A(.SDEC54,SDECRET,SDTOT,SDBEG,SDEND,USER,MAXREC,LSUB,.SDSUB) ;artf19425
G:SDEC54'<MAXREC XIT ;artf19425
;get RECALL and RECALL REMOVED data
I (LSUB="")!($P(LSUB,"|",2)="REC") D RECALL
G:SDEC54'<MAXREC XIT
;get recall appointments made
I (LSUB="")!($P(LSUB,"|",2)="REC") D RECAPPS ;artf19425
G:SDEC54'<MAXREC XIT
;get REQUEST/CONSULTATION data
I (LSUB="")!($P(LSUB,"|",2)="REQ") D REQGET
G:SDEC54'<MAXREC XIT
;get consult appointments made
I (LSUB="")!($P(LSUB,"|",2)="REQAP") D REQAPPS ;artf19425
G:SDEC54'<MAXREC XIT
XIT ;
K APPO ;alb/sat 642
I SDEC54>0 S SDTMP=$P(@SDECRET@(SDEC54),$C(30),1) S $P(SDTMP,U,19)=(SDTOT+SDEC54) S:SDSUB'="" $P(SDTMP,U,17)=SDSUB S @SDECRET@(SDEC54)=SDTMP_$C(30)
S @SDECRET@(SDEC54)=@SDECRET@(SDEC54)_$C(31)
Q
;
EWL ; get SD WAIT LIST data
;get WAIT LIST data
D WLINIT
S RET="^TMP(""SDEC"","_$J_")"
S NAMEPART=""
K @RET
S CLOSED=1
S FNUM=$$FNUM^SDECWL
;S WLIEN=0 F S WLIEN=$O(^SDWL(409.3,"C",DUZ(2),WLIEN)) Q:'WLIEN D
S SDT=$S($P(LSUB,"|",3)'="":$P(LSUB,"|",3)-.0001,1:$P(SDBEG,".",1))
F S SDT=$O(^SDWL(409.3,"AC",SDT)) Q:SDT'>0 Q:$P(SDT,".",1)>SDEND D I SDEC54'<MAXREC S:SDSUB="" SDSUB=(SDTOT+SDEC54)_"|EWL|"_SDT_"|"_SDU_"|"_WLIEN Q
.I USER'="" S SDU=USER D EWL1
.I USER="" S SDU=$S($P(LSUB,"|",4)'="":$P(LSUB,"|",4)-1,1:0) F S SDU=$O(^SDWL(409.3,"AC",SDT,SDU)) Q:SDU'>0 D EWL1 I SDEC54'<MAXREC S:SDSUB="" SDSUB=(SDTOT+SDEC54)_"|EWL|"_SDT_"|"_SDU_"|"_WLIEN Q
K @RET
Q
EWL1 ;
S WLIEN=$S($P(LSUB,"|",5)'="":$P(LSUB,"|",5),1:0) S LSUB="" F S WLIEN=$O(^SDWL(409.3,"AC",SDT,SDU,WLIEN)) Q:WLIEN'>0 D I SDEC54'<MAXREC S:SDSUB="" SDSUB=(SDTOT+SDEC54)_"|EWL|"_SDT_"|"_SDU_"|"_WLIEN Q
.S COUNT=0
.D ONEPAT^SDECWL1
.K WLDATA
.S WLDATA=$G(@RET@(COUNT))
.S WLDATA=$P(WLDATA,$C(30),1)
.S WLDATA=$P(WLDATA,$C(31),1)
.Q:WLDATA=""
.;get disposition data, if any
.;S DISPDT=$P($G(^SDWL(409.3,WLIEN,"DIS")),U,1)
.;S DISPU=$P($G(^SDWL(409.3,WLIEN,"DIS")),U,2)
.; 1 2 3 4 5 6
.S SDTMP="EWL"_U_$P(WLDATA,U,1)_U_$P(WLDATA,U,2)_U_$P(WLDATA,U,53)_U_$P(WLDATA,U,18)_U_$P(WLDATA,U,19)
.; 7 8 9 11
.S SDTMP=SDTMP_U_$P(WLDATA,U,41)_U_$P(WLDATA,U,42)_U_$P(WLDATA,U,43)_U_U_$P(WLDATA,U,29)
.S SDTMP=SDTMP_U_U_U_U_U_WLIEN_U_U_(SDTOT+SDEC54+1)
.S SDEC54=SDEC54+1 S @SDECRET@(SDEC54)=SDTMP_$C(30)
Q
WLAPPS ;get EWL appointments made ;alb/sat 642
N APPT,SDU,WLIEN,SDCNT,SDATA,SDECY,SDT,SDTMP
S SDT=$S($P(LSUB,"|",3)'="":$P(LSUB,"|",3),1:"")
F S SDT=$O(APPO("E",SDT)) Q:SDT="" D I SDEC54'<MAXREC S:SDSUB="" SDSUB=(SDTOT+SDEC54)_"|WLAP|"_SDT_"|"_SDU_"|"_SDCNT Q
.S SDU=$S($P(LSUB,"|",4)'="":$P(LSUB,"|",4),1:"")
.F S SDU=$O(APPO("E",SDT,SDU)) Q:SDU="" D I SDEC54'<MAXREC S:SDSUB="" SDSUB=(SDTOT+SDEC54)_"|WLAP|"_SDT_"|"_SDU_"|"_SDCNT Q
..S SDCNT=$S($P(LSUB,"|",5)'="":$P(LSUB,"|",5),1:"")
..F S SDCNT=$O(APPO("E",SDT,SDU,SDCNT)) Q:SDCNT="" D I SDEC54'<MAXREC S:SDSUB="" SDSUB=(SDTOT+SDEC54)_"|WLAP|"_SDT_"|"_SDU_"|"_SDCNT Q
...S WLIEN=APPO("E",SDT,SDU,SDCNT)
...;D ONEPAT^SDECWL1
...D WLGET^SDEC(.SDECY,WLIEN)
...Q:$G(@SDECY@(1))=""
...S APPT=SDT_"||"_SDU_"|"_$$GET1^DIQ(200,SDU_",",.01)
...S SDATA=@SDECY@(1)
...S SDATA=$P(SDATA,$C(30),1)
...S SDTMP="EWL"_U_$P(SDATA,U,1)_U_$P(SDATA,U,2)_U_U_$P(SDATA,U,18)_U_$P(SDATA,U,19) ;6
...S SDTMP=SDTMP_U_$P(SDATA,U,41)_U_$P(SDATA,U,42)_U_$P(SDATA,U,43)_U_U_$P(SDATA,U,29) ;11
...S SDTMP=SDTMP_U_APPT_U_U_U_U_WLIEN_U_U_(SDTOT+SDEC54+1) ;18
...S SDEC54=SDEC54+1 S @SDECRET@(SDEC54)=SDTMP_$C(30)
...K @SDECY
Q
;
APPT ; get SDEC APPT REQUEST data
;get WAIT LIST data
D WLINIT
S RET="^TMP(""SDEC"","_$J_")"
S NAMEPART=""
K @RET
S CLOSED=1
S FNUM=409.85
S SDT=$S($P(LSUB,"|",3)'="":$P(LSUB,"|",3)-.0001,1:$P(SDBEG,".",1))
F S SDT=$O(^SDEC(409.85,"AC",SDT)) Q:SDT'>0 Q:$P(SDT,".",1)>SDEND D I SDEC54'<MAXREC S:SDSUB="" SDSUB=(SDTOT+SDEC54)_"|APPT|"_SDT_"|"_SDU_"|"_ARIEN Q
.I USER'="" S SDU=USER D APPT1
.I USER="" S SDU=$S($P(LSUB,"|",4)'="":$P(LSUB,"|",4)-1,1:0) F S SDU=$O(^SDEC(409.85,"AC",SDT,SDU)) Q:SDU'>0 D APPT1 I SDEC54'<MAXREC S:SDSUB="" SDSUB=(SDTOT+SDEC54)_"|APPT|"_SDT_"|"_SDU_"|"_ARIEN Q
K @RET
Q
APPT1 ;
N PARENT
S ARIEN=$S($P(LSUB,"|",5)'="":$P(LSUB,"|",5),1:0) S LSUB="" F S ARIEN=$O(^SDEC(409.85,"AC",SDT,SDU,ARIEN)) Q:ARIEN'>0 D I SDEC54'<MAXREC S:SDSUB="" SDSUB=(SDTOT+SDEC54)_"|APPT|"_SDT_"|"_SDU_"|"_ARIEN Q
.S COUNT=0
.D ONEPAT^SDECAR1
.K WLDATA
.S WLDATA=$G(@RET@(COUNT))
.S WLDATA=$P(WLDATA,$C(30),1)
.S WLDATA=$P(WLDATA,$C(31),1)
.Q:WLDATA=""
.;get disposition data, if any
.;S DISPDT=$P($G(^SDEC(409.85,ARIEN,"DIS")),U,1)
.;S DISPU=$P($G(^SDEC(409.85,ARIEN,"DIS")),U,2)
.S PARENT=$S($P(WLDATA,U,66)'="":1,$P(WLDATA,U,67)=$P(WLDATA,U,7):1,1:0)
.; 1 2 3 4 5 6
.S SDTMP="APPT"_U_$P(WLDATA,U,1)_U_$P(WLDATA,U,2)_U_$P(WLDATA,U,46)_U_$P(WLDATA,U,14)_U_""
.; 7 8 9 10 11
.S SDTMP=SDTMP_U_$P(WLDATA,U,34)_U_$P(WLDATA,U,35)_U_$P(WLDATA,U,36)_U_""_U_$P(WLDATA,U,59)
.S SDTMP=SDTMP_U_U_U_U_U_ARIEN_U_U_(SDTOT+SDEC54+1)_U_U_PARENT
.S SDEC54=SDEC54+1 S @SDECRET@(SDEC54)=SDTMP_$C(30)
Q
APPTAPPS ;get APPT appointments made ;alb/sat 642
N SDU,APPT,ARIEN,COUNTQ,SDCNT,SDATA,PARENT,RET,SDT,SDTMP
;S RET="^TMP(""SDEC"","_$J_")"
;K @RET
S SDT=$S($P(LSUB,"|",3)'="":$P(LSUB,"|",3),1:"")
F S SDT=$O(APPO("A",SDT)) Q:SDT="" D I SDEC54'<MAXREC S:SDSUB="" SDSUB=(SDTOT+SDEC54)_"|APPTAP|"_SDT_"|"_SDU_"|"_SDCNT Q
.S SDU=$S($P(LSUB,"|",4)'="":$P(LSUB,"|",4),1:"")
.F S SDU=$O(APPO("A",SDT,SDU)) Q:SDU="" D I SDEC54'<MAXREC S:SDSUB="" SDSUB=(SDTOT+SDEC54)_"|APPTAP|"_SDT_"|"_SDU_"|"_SDCNT Q
..S SDCNT=$S($P(LSUB,"|",5)'="":$P(LSUB,"|",5),1:"")
..F S SDCNT=$O(APPO("A",SDT,SDU,SDCNT)) Q:SDCNT="" D I SDEC54'<MAXREC S:SDSUB="" SDSUB=(SDTOT+SDEC54)_"|APPTAP|"_SDT_"|"_SDU_"|"_SDCNT Q
...S ARIEN=APPO("A",SDT,SDU,SDCNT)
...S COUNT=0
...;D ONEPAT^SDECAR1
...D ARGET^SDEC(.RET,ARIEN)
...I $G(@RET@(1))="" K @RET Q
...S APPT=SDT_"||"_SDU_"|"_$$GET1^DIQ(200,SDU_",",.01)
...S SDATA=@RET@(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 SDTMP="APPT"_U_$P(SDATA,U,1)_U_$P(SDATA,U,2)_U_U_$P(SDATA,U,14)_U ;6
...S SDTMP=SDTMP_U_$P(SDATA,U,34)_U_$P(SDATA,U,35)_U_$P(SDATA,U,36)_U_U_$P(SDATA,U,59) ;11
...S SDTMP=SDTMP_U_APPT_U_U_U_U_ARIEN_U_U_(SDTOT+SDEC54+1)_U_U_+PARENT ;18
...S SDEC54=SDEC54+1 S @SDECRET@(SDEC54)=SDTMP_$C(30)
...K @RET
Q
;
REQGET ;get REQUEST/CONSULTATION data for SCHEDULED and CANCELED activities (from SDEC51)
N LSUB1,SDCAN,SDCANL,SDGMR,SDGMR0,SDI,SDJ,SDK,SDNOD,SDRPA,SDRPA0,SDSCHED,SDSCHEDF,STSTATF
N RQCNT,SDGMR,SDT,SDU
S RQCNT=SDEC54
S SDECY="^TMP(""SDEC"","_$J_")"
K @SDECY
S SDECI=0
S SDSCHEDF=0
S SDCAN=$$GETIEN^SDEC51("CANCELLED")
I SDCAN="" Q ;D ERR1^SDECERR(-1,"REQUEST ACTION TYPES file does not have an entry of RECEIVED.",.SDECI,SDECY) Q
S SDSCHED=$$GETIEN^SDEC51("SCHEDULED")
I SDSCHED="" Q ;D ERR1^SDECERR(-1,"REQUEST ACTION TYPES file does not have an entry of SCHEDULED.",.SDECI,SDECY) Q
;alb/sat 658 - new rules use AE instead of AG
N DRQ,OSACT,OSPEND,SVC,SDGMR,STAT
S OSACT=$O(^ORD(100.01,"B","ACTIVE",0))
S OSPEND=$O(^ORD(100.01,"B","PENDING",0))
S SDEC54=$G(SDEC54,0)
S SVC=$S($P(LSUB,"|",3)'="":$P(LSUB,"|",3)-1,1:0)
F S SVC=$O(^GMR(123,"AE",SVC)) Q:SVC="" D Q:SDECI>(MAXREC-1)
.F STAT=OSACT,OSPEND D Q:SDECI>(MAXREC-1)
..Q:STAT=""
..Q:($P(LSUB,"|",4)'="")&($P(LSUB,"|",4)'=STAT)
..S DRQ=$S($P(LSUB,"|",5)'="":$P(LSUB,"|",5)-.0001,1:SDBEG-1)
..F S DRQ=$O(^GMR(123,"AE",SVC,STAT,DRQ)) Q:DRQ="" Q:$P(DRQ,".",1)>SDEND D REQGET1 Q:SDECI>(MAXREC-1)
Q
REQGET1 ;
N SDSTATF
S SDGMR=$S($P(LSUB,"|",6)'="":$P(LSUB,"|",6),1:0)
S LSUB=""
F S SDGMR=$O(^GMR(123,"AE",SVC,STAT,DRQ,SDGMR)) Q:SDGMR="" D I SDEC54'<MAXREC S SDSUB=(SDTOT+SDEC54)_"|REQ|"_SVC_"|"_STAT_"|"_DRQ_"|"_SDGMR Q
.S SDCANL=""
.S (SDSCHEDF,SDSTATF)=0
.S SDRPA=0 F S SDRPA=$O(^GMR(123,SDGMR,40,SDRPA)) Q:SDRPA'>0 D
..S SDRPA0=$G(^GMR(123,SDGMR,40,SDRPA,0)) ;ICR 6185
..I USER="",$P(SDRPA0,U,4)'=USER Q
..I ($P(SDRPA0,U,2)=SDCAN)!($P(SDRPA0,U,2)=SDSCHED) D
...S SDCANL=$S(SDCANL'="":SDCANL_"|",1:"")_SDGMR_";;"_SDRPA_";;"_$$FMTE^XLFDT($P(SDRPA0,U,1))
...S SDCANL=SDCANL_";;"_$$GET1^DIQ(123.02,SDRPA_","_SDGMR_",",1)_";;"_$P(SDRPA0,U,5)_";;"_$P($G(^VA(200,+$P(SDRPA0,U,5),0)),U,1)
.I SDCANL'="" D
..S DFN=$$GET1^DIQ(123,SDGMR_",",.02,"I")
..;collect demographics
..S NAME=$$GET1^DIQ(2,DFN_",",.01) ;SDDEMO("NAME")
..K SDDATA,SDMSG
..;SDCANL=<REQUEST PROCESSING ACTIVITY pointer> ;; <DATE/TIME OF ACTION ENTRY> ;; <ACTIVITY> ;; <WHO ENTERED ACTIVITY ien> ;; <WHO ENTERED ACTIVITY name>
..S SDTMP="CONSULT"_U_DFN_U_NAME_U_$$GET1^DIQ(123,SDGMR_",",3,"I")_U_U ;6
..S SDTMP=SDTMP_U_U_U_U_U ;11
..S SDTMP=SDTMP_U_U_U_U_SDCANL_U_SDGMR_U_U_(SDTOT+SDEC54+1) ;18
..S SDEC54=SDEC54+1 S @SDECRET@(SDEC54)=SDTMP_$C(30)
Q
REQAPPS ;get recall appointments made ;alb/sat 642
N APPT,SDU,SDID,SDCNT,SDATA,SDECY,SDT,SDTMP
S SDT=$S($P(LSUB,"|",3)'="":$P(LSUB,"|",3),1:"")
F S SDT=$O(APPO("C",SDT)) Q:SDT="" D I SDEC54'<MAXREC S:SDSUB="" SDSUB=(SDTOT+SDEC54)_"|REQAP|"_SDT_"|"_SDU_"|"_SDCNT Q
.S SDU=$S($P(LSUB,"|",4)'="":$P(LSUB,"|",4),1:"")
.F S SDU=$O(APPO("C",SDT,SDU)) Q:SDU="" D I SDEC54'<MAXREC S:SDSUB="" SDSUB=(SDTOT+SDEC54)_"|REQAP|"_SDT_"|"_SDU_"|"_SDCNT Q
..S SDCNT=$S($P(LSUB,"|",5)'="":$P(LSUB,"|",5),1:"")
..F S SDCNT=$O(APPO("C",SDT,SDU,SDCNT)) Q:SDCNT="" D I SDEC54'<MAXREC S:SDSUB="" SDSUB=(SDTOT+SDEC54)_"|REQAP|"_SDT_"|"_SDU_"|"_SDCNT Q
...S SDID=APPO("C",SDT,SDU,SDCNT)
...D REQGET^SDEC(.SDECY,,,,,SDID)
...Q:$G(@SDECY@(1))=""
...S SDATA=@SDECY@(1)
...S SDATA=$P(SDATA,$C(30),1)
...S APPT=SDT_"||"_SDU_"|"_$$GET1^DIQ(200,SDU_",",.01)
...S SDTMP="CONSULT"_U_$P(SDATA,U,3)_U_$P(SDATA,U,4)_U_U_U ;6
...S SDTMP=SDTMP_U_U_U_U_U ;11
...S SDTMP=SDTMP_U_APPT_U_$P(SDATA,U,6)_U_$P(SDATA,U,7)_U_U_$P(SDATA,U,1)_U_U_(SDTOT+SDEC54+1) ;18
...S SDEC54=SDEC54+1 S @SDECRET@(SDEC54)=SDTMP_$C(30)
...K @SDECY
Q
;
RECALL ;get RECALL REMINDERS data
N SDECY,SDR,SDT,SDU
S SDT=$S($P(LSUB,"|",3)'="":$P(LSUB,"|",3)-.0001,1:$P(SDBEG,".",1))
F S SDT=$O(^SD(403.5,"AC",SDT)) Q:SDT'>0 Q:$P(SDT,".",1)>SDEND D I SDEC54'<MAXREC S:SDSUB="" SDSUB=(SDTOT+SDEC54)_"|REC|"_SDT_"|"_SDU_"|"_SDR Q
.I USER'="" S SDU=USER D RECALL1
.I USER="" S SDU=$S($P(LSUB,"|",4)'="":$P(LSUB,"|",4)-1,1:0) F S SDU=$O(^SD(403.5,"AC",SDT,SDU)) Q:SDU'>0 Q:(USER'="")&(SDU'=USER) D RECALL1 I SDEC54'<MAXREC S:SDSUB="" SDSUB=(SDTOT+SDEC54)_"|REC|"_SDT_"|"_SDU_"|"_SDR Q
Q
RECALL1 ;
S SDR=$S($P(LSUB,"|",5)'="":$P(LSUB,"|",5),1:0) F S SDR=$O(^SD(403.5,"AC",SDT,SDU,SDR)) Q:SDR'>0 D I SDEC54'<MAXREC S:SDSUB="" SDSUB=(SDTOT+SDEC54)_"|REC|"_SDT_"|"_SDU_"|"_SDR Q
.S SDECY=""
.D RECIEN^SDEC(.SDECY,SDR)
.Q:$G(@SDECY@(1))=""
.S WLDATA=@SDECY@(1)
.S WLDATA=$P(WLDATA,$C(30),1)
.S SDTMP="RECALL"_U_$P(WLDATA,U,2)_U_$P(WLDATA,U,3)_U_$P(WLDATA,U,32)_U_$P(WLDATA,U,22)_U_$P(WLDATA,U,23) ;6
.S SDTMP=SDTMP_U_U_U_U_U ;11
.S SDTMP=SDTMP_U_U_$P(WLDATA,U,16)_U_$P(WLDATA,U,17)_U_U_$P(WLDATA,U,1)_U_U_(SDTOT+SDEC54+1) ;18 ;alb/sat 642 null for DATE2
.S SDEC54=SDEC54+1 S @SDECRET@(SDEC54)=SDTMP_$C(30)
.K @SDECY
Q
;
RECAPPS ;get recall appointments made ;alb/sat 642
N APPT,SDU,SDID,SDCNT,SDATA,SDECY,SDT,SDTMP
S SDT=$S($P(LSUB,"|",3)'="":$P(LSUB,"|",3),1:"")
F S SDT=$O(APPO("R",SDT)) Q:SDT="" D I SDEC54'<MAXREC S:SDSUB="" SDSUB=(SDTOT+SDEC54)_"|RECAP|"_SDT_"|"_SDU_"|"_SDCNT Q
.S SDU=$S($P(LSUB,"|",4)'="":$P(LSUB,"|",4),1:"")
.F S SDU=$O(APPO("R",SDT,SDU)) Q:SDU="" D I SDEC54'<MAXREC S:SDSUB="" SDSUB=(SDTOT+SDEC54)_"|RECAP|"_SDT_"|"_SDU_"|"_SDCNT Q
..S SDCNT=$S($P(LSUB,"|",5)'="":$P(LSUB,"|",5),1:"")
..F S SDCNT=$O(APPO("R",SDT,SDU,SDCNT)) Q:SDCNT="" D I SDEC54'<MAXREC S:SDSUB="" SDSUB=(SDTOT+SDEC54)_"|RECAP|"_SDT_"|"_SDU_"|"_SDCNT Q
...S SDID=APPO("R",SDT,SDU,SDCNT)
...D RECIEN^SDEC(.SDECY,SDID)
...Q:$G(@SDECY@(1))=""
...S SDATA=@SDECY@(1)
...S SDATA=$P(SDATA,$C(30),1)
...S APPT=SDT_"||"_SDU_"|"_$$GET1^DIQ(200,SDU_",",.01)
...S SDTMP="RECALL"_U_$P(SDATA,U,2)_U_$P(SDATA,U,3)_U_U_$P(SDATA,U,22)_U_$P(SDATA,U,23) ;6
...S SDTMP=SDTMP_U_U_U_U_U ;11
...S SDTMP=SDTMP_U_APPT_U_$P(SDATA,U,16)_U_$P(SDATA,U,17)_U_U_$P(SDATA,U,1)_U_U_(SDTOT+SDEC54+1) ;18
...S SDEC54=SDEC54+1 S @SDECRET@(SDEC54)=SDTMP_$C(30)
...K @SDECY
Q
;
DEMO ;get patient demographics
N SDDEMO
D PDEMO^SDECU3(.SDDEMO,DFN) ;alb/sat 658 PDEMO moved to SDECU3
S NAME=SDDEMO("NAME")
Q
;
WLINIT ;
N NAME,NAMEPART,DOB,GENDER,HRN,SSN,INSTIEN,INSTNAME
N PRIGRP,ELIGIEN,ELIGNAME,SVCCONN,SVCCONNP,TYPEIEN
N TYPENAME,PTPHONE,WLORIGDT,WLINST,WLINSTNM,WLTYPE
N WLTEAM,WLPOS,WLSSIEN,WLSSNAME,WLCLIEN,WLCLNAME
N WLUSER,WLUSRNM,WLPRIO,WLENPRI,WLREQBY,WLPROV
N WLPROVNM,WLDAPTDT,WLCOMM,WLEESTAT,WLASD,WLMAR
N WLMAI,WLMAN,WLPC
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDEC54 16238 printed Apr 09, 2024@21:42:55 Page 2
SDEC54 ;ALB/SAT - VISTA SCHEDULING RPCS ;JUN 21, 2017
+1 ;;5.3;Scheduling;**627,642,658,665**;Aug 13, 1993;Build 14
+2 ;
+3 ;Reference is made to ICR #6185
+4 QUIT
+5 ;
+6 ;DATE RANGE FOR INPUT
SUMMGET(SDECRET,SDBEG,SDEND,USER,LSUB,MAXREC) ;GET Audit Summary for given date range
+1 NEW CLOSED,COUNT,DFN,DISPDT,DISPU,FNUM,NAMEPART,PROVNAME,RET,WLDATA,WLIEN,X,Y,%DT
+2 ;alb/sat 642 added APPO
NEW APPO,ARIEN,SDDATA,SDEC54,SDECI,SDECY,SDNUM,SDTMP,SDTOT,SDDEMO,SDSUB,SDT,SDU,USER1
+3 SET SDECRET="^TMP(""SDEC54"","_$JOB_",""SUMMGET"")"
+4 KILL @SDECRET
+5 SET SDSUB=""
+6 SET SDEC54=0
+7 ; 1 2 3 4 5 6
+8 SET SDTMP="T00030REQUESTTYPE^T00030DFN^T00030NAME^T00030DATE^T00030USERIEN^T00030USERNAME"
+9 ; 7 8 9 10 11
+10 SET SDTMP=SDTMP_"^T00030DATE1^T00030PROVIEN^T00030PROVNAME^T00030PCONTACT^T00030APPT_SCHED_DATE"
+11 ; 12 13 14 15
+12 SET SDTMP=SDTMP_"^T00030DATE2^T00030CLINIEN^T00030CLINNAME^T00030ACTIVITY^T00030IEN"
+13 SET SDTMP=SDTMP_"^T00030LASTSUB^T00030NUMBER^T00030TOTAL^T00030MRTC"
+14 SET @SDECRET@(SDEC54)=SDTMP_$CHAR(30)
+15 ;check begin date (optional)
+16 ;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
+17 ;alb/sat 658 use valid FM range instead of 1000101
IF $GET(SDBEG)=""
SET SDBEG=1410102
+18 ;check end date (optional)
+19 ;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
+20 ;alb/sat 658 use valid FM range instead of 9991231
IF $GET(SDEND)=""
SET SDEND=4141015
+21 ;check user
+22 SET USER=$GET(USER)
+23 IF '$DATA(^VA(200,+USER,0))
SET USER=""
+24 ;check LSUB <COUNT> | <TYPE> | <SUBSCRIPT [ <SUBSCRIPT> ...
+25 SET LSUB=$GET(LSUB)
+26 SET SDTOT=+$PIECE(LSUB,"|",1)
+27 ;check MAXREC
+28 ;alb/sat 665 - remove limits
SET MAXREC=$GET(MAXREC)
if '+MAXREC
SET MAXREC=9999999
+29 ;get SDEC APPOINTMENT entries with DATE APPT MADE in date range ;alb/sat 642
+30 ;artf19425
DO APPO^SDEC54A(.APPO,SDBEG,SDEND,USER)
+31 ;get SDEC APPT REQUEST data
+32 IF (LSUB="")!($PIECE(LSUB,"|",2)="APPT")
DO APPT
+33 if SDEC54'<MAXREC
GOTO XIT
+34 ;artf19425
IF (LSUB="")!($PIECE(LSUB,"|",2)="APPTAP")
DO APPTAPPS
+35 if SDEC54'<MAXREC
GOTO XIT
+36 ;get patient contacts from APPT
+37 ;artf19425
IF (LSUB="")!($PIECE(LSUB,"|",2)="APPTPC")
DO APPTPC^SDEC54A(.SDEC54,SDECRET,SDTOT,SDBEG,SDEND,USER,MAXREC,LSUB,.SDSUB)
+38 ;artf19425
if SDEC54'<MAXREC
GOTO XIT
+39 ;get SD WAIT LIST data
+40 IF (LSUB="")!($PIECE(LSUB,"|",2)="EWL")
DO EWL
+41 if SDEC54'<MAXREC
GOTO XIT
+42 ;artf19425
IF (LSUB="")!($PIECE(LSUB,"|",2)="WLAP")
DO WLAPPS
+43 if SDEC54'<MAXREC
GOTO XIT
+44 ;get patient contacts from wait list
+45 ;artf19425
IF (LSUB="")!($PIECE(LSUB,"|",2)="EWLPC")
DO EWLPC^SDEC54A(.SDEC54,SDECRET,SDTOT,SDBEG,SDEND,USER,MAXREC,LSUB,.SDSUB)
+46 ;artf19425
if SDEC54'<MAXREC
GOTO XIT
+47 ;get RECALL and RECALL REMOVED data
+48 IF (LSUB="")!($PIECE(LSUB,"|",2)="REC")
DO RECALL
+49 if SDEC54'<MAXREC
GOTO XIT
+50 ;get recall appointments made
+51 ;artf19425
IF (LSUB="")!($PIECE(LSUB,"|",2)="REC")
DO RECAPPS
+52 if SDEC54'<MAXREC
GOTO XIT
+53 ;get REQUEST/CONSULTATION data
+54 IF (LSUB="")!($PIECE(LSUB,"|",2)="REQ")
DO REQGET
+55 if SDEC54'<MAXREC
GOTO XIT
+56 ;get consult appointments made
+57 ;artf19425
IF (LSUB="")!($PIECE(LSUB,"|",2)="REQAP")
DO REQAPPS
+58 if SDEC54'<MAXREC
GOTO XIT
XIT ;
+1 ;alb/sat 642
KILL APPO
+2 IF SDEC54>0
SET SDTMP=$PIECE(@SDECRET@(SDEC54),$CHAR(30),1)
SET $PIECE(SDTMP,U,19)=(SDTOT+SDEC54)
if SDSUB'=""
SET $PIECE(SDTMP,U,17)=SDSUB
SET @SDECRET@(SDEC54)=SDTMP_$CHAR(30)
+3 SET @SDECRET@(SDEC54)=@SDECRET@(SDEC54)_$CHAR(31)
+4 QUIT
+5 ;
EWL ; get SD WAIT LIST data
+1 ;get WAIT LIST data
+2 DO WLINIT
+3 SET RET="^TMP(""SDEC"","_$JOB_")"
+4 SET NAMEPART=""
+5 KILL @RET
+6 SET CLOSED=1
+7 SET FNUM=$$FNUM^SDECWL
+8 ;S WLIEN=0 F S WLIEN=$O(^SDWL(409.3,"C",DUZ(2),WLIEN)) Q:'WLIEN D
+9 SET SDT=$SELECT($PIECE(LSUB,"|",3)'="":$PIECE(LSUB,"|",3)-.0001,1:$PIECE(SDBEG,".",1))
+10 FOR
SET SDT=$ORDER(^SDWL(409.3,"AC",SDT))
if SDT'>0
QUIT
if $PIECE(SDT,".",1)>SDEND
QUIT
Begin DoDot:1
+11 IF USER'=""
SET SDU=USER
DO EWL1
+12 IF USER=""
SET SDU=$SELECT($PIECE(LSUB,"|",4)'="":$PIECE(LSUB,"|",4)-1,1:0)
FOR
SET SDU=$ORDER(^SDWL(409.3,"AC",SDT,SDU))
if SDU'>0
QUIT
DO EWL1
IF SDEC54'<MAXREC
if SDSUB=""
SET SDSUB=(SDTOT+SDEC54)_"|EWL|"_SDT_"|"_SDU_"|"_WLIEN
QUIT
End DoDot:1
IF SDEC54'<MAXREC
if SDSUB=""
SET SDSUB=(SDTOT+SDEC54)_"|EWL|"_SDT_"|"_SDU_"|"_WLIEN
QUIT
+13 KILL @RET
+14 QUIT
EWL1 ;
+1 SET WLIEN=$SELECT($PIECE(LSUB,"|",5)'="":$PIECE(LSUB,"|",5),1:0)
SET LSUB=""
FOR
SET WLIEN=$ORDER(^SDWL(409.3,"AC",SDT,SDU,WLIEN))
if WLIEN'>0
QUIT
Begin DoDot:1
+2 SET COUNT=0
+3 DO ONEPAT^SDECWL1
+4 KILL WLDATA
+5 SET WLDATA=$GET(@RET@(COUNT))
+6 SET WLDATA=$PIECE(WLDATA,$CHAR(30),1)
+7 SET WLDATA=$PIECE(WLDATA,$CHAR(31),1)
+8 if WLDATA=""
QUIT
+9 ;get disposition data, if any
+10 ;S DISPDT=$P($G(^SDWL(409.3,WLIEN,"DIS")),U,1)
+11 ;S DISPU=$P($G(^SDWL(409.3,WLIEN,"DIS")),U,2)
+12 ; 1 2 3 4 5 6
+13 SET SDTMP="EWL"_U_$PIECE(WLDATA,U,1)_U_$PIECE(WLDATA,U,2)_U_$PIECE(WLDATA,U,53)_U_$PIECE(WLDATA,U,18)_U_$PIECE(WLDATA,U,19)
+14 ; 7 8 9 11
+15 SET SDTMP=SDTMP_U_$PIECE(WLDATA,U,41)_U_$PIECE(WLDATA,U,42)_U_$PIECE(WLDATA,U,43)_U_U_$PIECE(WLDATA,U,29)
+16 SET SDTMP=SDTMP_U_U_U_U_U_WLIEN_U_U_(SDTOT+SDEC54+1)
+17 SET SDEC54=SDEC54+1
SET @SDECRET@(SDEC54)=SDTMP_$CHAR(30)
End DoDot:1
IF SDEC54'<MAXREC
if SDSUB=""
SET SDSUB=(SDTOT+SDEC54)_"|EWL|"_SDT_"|"_SDU_"|"_WLIEN
QUIT
+18 QUIT
WLAPPS ;get EWL appointments made ;alb/sat 642
+1 NEW APPT,SDU,WLIEN,SDCNT,SDATA,SDECY,SDT,SDTMP
+2 SET SDT=$SELECT($PIECE(LSUB,"|",3)'="":$PIECE(LSUB,"|",3),1:"")
+3 FOR
SET SDT=$ORDER(APPO("E",SDT))
if SDT=""
QUIT
Begin DoDot:1
+4 SET SDU=$SELECT($PIECE(LSUB,"|",4)'="":$PIECE(LSUB,"|",4),1:"")
+5 FOR
SET SDU=$ORDER(APPO("E",SDT,SDU))
if SDU=""
QUIT
Begin DoDot:2
+6 SET SDCNT=$SELECT($PIECE(LSUB,"|",5)'="":$PIECE(LSUB,"|",5),1:"")
+7 FOR
SET SDCNT=$ORDER(APPO("E",SDT,SDU,SDCNT))
if SDCNT=""
QUIT
Begin DoDot:3
+8 SET WLIEN=APPO("E",SDT,SDU,SDCNT)
+9 ;D ONEPAT^SDECWL1
+10 DO WLGET^SDEC(.SDECY,WLIEN)
+11 if $GET(@SDECY@(1))=""
QUIT
+12 SET APPT=SDT_"||"_SDU_"|"_$$GET1^DIQ(200,SDU_",",.01)
+13 SET SDATA=@SDECY@(1)
+14 SET SDATA=$PIECE(SDATA,$CHAR(30),1)
+15 ;6
SET SDTMP="EWL"_U_$PIECE(SDATA,U,1)_U_$PIECE(SDATA,U,2)_U_U_$PIECE(SDATA,U,18)_U_$PIECE(SDATA,U,19)
+16 ;11
SET SDTMP=SDTMP_U_$PIECE(SDATA,U,41)_U_$PIECE(SDATA,U,42)_U_$PIECE(SDATA,U,43)_U_U_$PIECE(SDATA,U,29)
+17 ;18
SET SDTMP=SDTMP_U_APPT_U_U_U_U_WLIEN_U_U_(SDTOT+SDEC54+1)
+18 SET SDEC54=SDEC54+1
SET @SDECRET@(SDEC54)=SDTMP_$CHAR(30)
+19 KILL @SDECY
End DoDot:3
IF SDEC54'<MAXREC
if SDSUB=""
SET SDSUB=(SDTOT+SDEC54)_"|WLAP|"_SDT_"|"_SDU_"|"_SDCNT
QUIT
End DoDot:2
IF SDEC54'<MAXREC
if SDSUB=""
SET SDSUB=(SDTOT+SDEC54)_"|WLAP|"_SDT_"|"_SDU_"|"_SDCNT
QUIT
End DoDot:1
IF SDEC54'<MAXREC
if SDSUB=""
SET SDSUB=(SDTOT+SDEC54)_"|WLAP|"_SDT_"|"_SDU_"|"_SDCNT
QUIT
+20 QUIT
+21 ;
APPT ; get SDEC APPT REQUEST data
+1 ;get WAIT LIST data
+2 DO WLINIT
+3 SET RET="^TMP(""SDEC"","_$JOB_")"
+4 SET NAMEPART=""
+5 KILL @RET
+6 SET CLOSED=1
+7 SET FNUM=409.85
+8 SET SDT=$SELECT($PIECE(LSUB,"|",3)'="":$PIECE(LSUB,"|",3)-.0001,1:$PIECE(SDBEG,".",1))
+9 FOR
SET SDT=$ORDER(^SDEC(409.85,"AC",SDT))
if SDT'>0
QUIT
if $PIECE(SDT,".",1)>SDEND
QUIT
Begin DoDot:1
+10 IF USER'=""
SET SDU=USER
DO APPT1
+11 IF USER=""
SET SDU=$SELECT($PIECE(LSUB,"|",4)'="":$PIECE(LSUB,"|",4)-1,1:0)
FOR
SET SDU=$ORDER(^SDEC(409.85,"AC",SDT,SDU))
if SDU'>0
QUIT
DO APPT1
IF SDEC54'<MAXREC
if SDSUB=""
SET SDSUB=(SDTOT+SDEC54)_"|APPT|"_SDT_"|"_SDU_"|"_ARIEN
QUIT
End DoDot:1
IF SDEC54'<MAXREC
if SDSUB=""
SET SDSUB=(SDTOT+SDEC54)_"|APPT|"_SDT_"|"_SDU_"|"_ARIEN
QUIT
+12 KILL @RET
+13 QUIT
APPT1 ;
+1 NEW PARENT
+2 SET ARIEN=$SELECT($PIECE(LSUB,"|",5)'="":$PIECE(LSUB,"|",5),1:0)
SET LSUB=""
FOR
SET ARIEN=$ORDER(^SDEC(409.85,"AC",SDT,SDU,ARIEN))
if ARIEN'>0
QUIT
Begin DoDot:1
+3 SET COUNT=0
+4 DO ONEPAT^SDECAR1
+5 KILL WLDATA
+6 SET WLDATA=$GET(@RET@(COUNT))
+7 SET WLDATA=$PIECE(WLDATA,$CHAR(30),1)
+8 SET WLDATA=$PIECE(WLDATA,$CHAR(31),1)
+9 if WLDATA=""
QUIT
+10 ;get disposition data, if any
+11 ;S DISPDT=$P($G(^SDEC(409.85,ARIEN,"DIS")),U,1)
+12 ;S DISPU=$P($G(^SDEC(409.85,ARIEN,"DIS")),U,2)
+13 SET PARENT=$SELECT($PIECE(WLDATA,U,66)'="":1,$PIECE(WLDATA,U,67)=$PIECE(WLDATA,U,7):1,1:0)
+14 ; 1 2 3 4 5 6
+15 SET SDTMP="APPT"_U_$PIECE(WLDATA,U,1)_U_$PIECE(WLDATA,U,2)_U_$PIECE(WLDATA,U,46)_U_$PIECE(WLDATA,U,14)_U_""
+16 ; 7 8 9 10 11
+17 SET SDTMP=SDTMP_U_$PIECE(WLDATA,U,34)_U_$PIECE(WLDATA,U,35)_U_$PIECE(WLDATA,U,36)_U_""_U_$PIECE(WLDATA,U,59)
+18 SET SDTMP=SDTMP_U_U_U_U_U_ARIEN_U_U_(SDTOT+SDEC54+1)_U_U_PARENT
+19 SET SDEC54=SDEC54+1
SET @SDECRET@(SDEC54)=SDTMP_$CHAR(30)
End DoDot:1
IF SDEC54'<MAXREC
if SDSUB=""
SET SDSUB=(SDTOT+SDEC54)_"|APPT|"_SDT_"|"_SDU_"|"_ARIEN
QUIT
+20 QUIT
APPTAPPS ;get APPT appointments made ;alb/sat 642
+1 NEW SDU,APPT,ARIEN,COUNTQ,SDCNT,SDATA,PARENT,RET,SDT,SDTMP
+2 ;S RET="^TMP(""SDEC"","_$J_")"
+3 ;K @RET
+4 SET SDT=$SELECT($PIECE(LSUB,"|",3)'="":$PIECE(LSUB,"|",3),1:"")
+5 FOR
SET SDT=$ORDER(APPO("A",SDT))
if SDT=""
QUIT
Begin DoDot:1
+6 SET SDU=$SELECT($PIECE(LSUB,"|",4)'="":$PIECE(LSUB,"|",4),1:"")
+7 FOR
SET SDU=$ORDER(APPO("A",SDT,SDU))
if SDU=""
QUIT
Begin DoDot:2
+8 SET SDCNT=$SELECT($PIECE(LSUB,"|",5)'="":$PIECE(LSUB,"|",5),1:"")
+9 FOR
SET SDCNT=$ORDER(APPO("A",SDT,SDU,SDCNT))
if SDCNT=""
QUIT
Begin DoDot:3
+10 SET ARIEN=APPO("A",SDT,SDU,SDCNT)
+11 SET COUNT=0
+12 ;D ONEPAT^SDECAR1
+13 DO ARGET^SDEC(.RET,ARIEN)
+14 IF $GET(@RET@(1))=""
KILL @RET
QUIT
+15 SET APPT=SDT_"||"_SDU_"|"_$$GET1^DIQ(200,SDU_",",.01)
+16 SET SDATA=@RET@(1)
+17 SET SDATA=$PIECE(SDATA,$CHAR(30),1)
+18 SET PARENT=$SELECT($PIECE(SDATA,U,66)'="":1,$PIECE(SDATA,U,67)=$PIECE(SDATA,U,7):1,1:0)
+19 ;6
SET SDTMP="APPT"_U_$PIECE(SDATA,U,1)_U_$PIECE(SDATA,U,2)_U_U_$PIECE(SDATA,U,14)_U
+20 ;11
SET SDTMP=SDTMP_U_$PIECE(SDATA,U,34)_U_$PIECE(SDATA,U,35)_U_$PIECE(SDATA,U,36)_U_U_$PIECE(SDATA,U,59)
+21 ;18
SET SDTMP=SDTMP_U_APPT_U_U_U_U_ARIEN_U_U_(SDTOT+SDEC54+1)_U_U_+PARENT
+22 SET SDEC54=SDEC54+1
SET @SDECRET@(SDEC54)=SDTMP_$CHAR(30)
+23 KILL @RET
End DoDot:3
IF SDEC54'<MAXREC
if SDSUB=""
SET SDSUB=(SDTOT+SDEC54)_"|APPTAP|"_SDT_"|"_SDU_"|"_SDCNT
QUIT
End DoDot:2
IF SDEC54'<MAXREC
if SDSUB=""
SET SDSUB=(SDTOT+SDEC54)_"|APPTAP|"_SDT_"|"_SDU_"|"_SDCNT
QUIT
End DoDot:1
IF SDEC54'<MAXREC
if SDSUB=""
SET SDSUB=(SDTOT+SDEC54)_"|APPTAP|"_SDT_"|"_SDU_"|"_SDCNT
QUIT
+24 QUIT
+25 ;
REQGET ;get REQUEST/CONSULTATION data for SCHEDULED and CANCELED activities (from SDEC51)
+1 NEW LSUB1,SDCAN,SDCANL,SDGMR,SDGMR0,SDI,SDJ,SDK,SDNOD,SDRPA,SDRPA0,SDSCHED,SDSCHEDF,STSTATF
+2 NEW RQCNT,SDGMR,SDT,SDU
+3 SET RQCNT=SDEC54
+4 SET SDECY="^TMP(""SDEC"","_$JOB_")"
+5 KILL @SDECY
+6 SET SDECI=0
+7 SET SDSCHEDF=0
+8 SET SDCAN=$$GETIEN^SDEC51("CANCELLED")
+9 ;D ERR1^SDECERR(-1,"REQUEST ACTION TYPES file does not have an entry of RECEIVED.",.SDECI,SDECY) Q
IF SDCAN=""
QUIT
+10 SET SDSCHED=$$GETIEN^SDEC51("SCHEDULED")
+11 ;D ERR1^SDECERR(-1,"REQUEST ACTION TYPES file does not have an entry of SCHEDULED.",.SDECI,SDECY) Q
IF SDSCHED=""
QUIT
+12 ;alb/sat 658 - new rules use AE instead of AG
+13 NEW DRQ,OSACT,OSPEND,SVC,SDGMR,STAT
+14 SET OSACT=$ORDER(^ORD(100.01,"B","ACTIVE",0))
+15 SET OSPEND=$ORDER(^ORD(100.01,"B","PENDING",0))
+16 SET SDEC54=$GET(SDEC54,0)
+17 SET SVC=$SELECT($PIECE(LSUB,"|",3)'="":$PIECE(LSUB,"|",3)-1,1:0)
+18 FOR
SET SVC=$ORDER(^GMR(123,"AE",SVC))
if SVC=""
QUIT
Begin DoDot:1
+19 FOR STAT=OSACT,OSPEND
Begin DoDot:2
+20 if STAT=""
QUIT
+21 if ($PIECE(LSUB,"|",4)'="")&($PIECE(LSUB,"|",4)'=STAT)
QUIT
+22 SET DRQ=$SELECT($PIECE(LSUB,"|",5)'="":$PIECE(LSUB,"|",5)-.0001,1:SDBEG-1)
+23 FOR
SET DRQ=$ORDER(^GMR(123,"AE",SVC,STAT,DRQ))
if DRQ=""
QUIT
if $PIECE(DRQ,".",1)>SDEND
QUIT
DO REQGET1
if SDECI>(MAXREC-1)
QUIT
End DoDot:2
if SDECI>(MAXREC-1)
QUIT
End DoDot:1
if SDECI>(MAXREC-1)
QUIT
+24 QUIT
REQGET1 ;
+1 NEW SDSTATF
+2 SET SDGMR=$SELECT($PIECE(LSUB,"|",6)'="":$PIECE(LSUB,"|",6),1:0)
+3 SET LSUB=""
+4 FOR
SET SDGMR=$ORDER(^GMR(123,"AE",SVC,STAT,DRQ,SDGMR))
if SDGMR=""
QUIT
Begin DoDot:1
+5 SET SDCANL=""
+6 SET (SDSCHEDF,SDSTATF)=0
+7 SET SDRPA=0
FOR
SET SDRPA=$ORDER(^GMR(123,SDGMR,40,SDRPA))
if SDRPA'>0
QUIT
Begin DoDot:2
+8 ;ICR 6185
SET SDRPA0=$GET(^GMR(123,SDGMR,40,SDRPA,0))
+9 IF USER=""
IF $PIECE(SDRPA0,U,4)'=USER
QUIT
+10 IF ($PIECE(SDRPA0,U,2)=SDCAN)!($PIECE(SDRPA0,U,2)=SDSCHED)
Begin DoDot:3
+11 SET SDCANL=$SELECT(SDCANL'="":SDCANL_"|",1:"")_SDGMR_";;"_SDRPA_";;"_$$FMTE^XLFDT($PIECE(SDRPA0,U,1))
+12 SET SDCANL=SDCANL_";;"_$$GET1^DIQ(123.02,SDRPA_","_SDGMR_",",1)_";;"_$PIECE(SDRPA0,U,5)_";;"_$PIECE($GET(^VA(200,+$PIECE(SDRPA0,U,5),0)),U,1)
End DoDot:3
End DoDot:2
+13 IF SDCANL'=""
Begin DoDot:2
+14 SET DFN=$$GET1^DIQ(123,SDGMR_",",.02,"I")
+15 ;collect demographics
+16 ;SDDEMO("NAME")
SET NAME=$$GET1^DIQ(2,DFN_",",.01)
+17 KILL SDDATA,SDMSG
+18 ;SDCANL=<REQUEST PROCESSING ACTIVITY pointer> ;; <DATE/TIME OF ACTION ENTRY> ;; <ACTIVITY> ;; <WHO ENTERED ACTIVITY ien> ;; <WHO ENTERED ACTIVITY name>
+19 ;6
SET SDTMP="CONSULT"_U_DFN_U_NAME_U_$$GET1^DIQ(123,SDGMR_",",3,"I")_U_U
+20 ;11
SET SDTMP=SDTMP_U_U_U_U_U
+21 ;18
SET SDTMP=SDTMP_U_U_U_U_SDCANL_U_SDGMR_U_U_(SDTOT+SDEC54+1)
+22 SET SDEC54=SDEC54+1
SET @SDECRET@(SDEC54)=SDTMP_$CHAR(30)
End DoDot:2
End DoDot:1
IF SDEC54'<MAXREC
SET SDSUB=(SDTOT+SDEC54)_"|REQ|"_SVC_"|"_STAT_"|"_DRQ_"|"_SDGMR
QUIT
+23 QUIT
REQAPPS ;get recall appointments made ;alb/sat 642
+1 NEW APPT,SDU,SDID,SDCNT,SDATA,SDECY,SDT,SDTMP
+2 SET SDT=$SELECT($PIECE(LSUB,"|",3)'="":$PIECE(LSUB,"|",3),1:"")
+3 FOR
SET SDT=$ORDER(APPO("C",SDT))
if SDT=""
QUIT
Begin DoDot:1
+4 SET SDU=$SELECT($PIECE(LSUB,"|",4)'="":$PIECE(LSUB,"|",4),1:"")
+5 FOR
SET SDU=$ORDER(APPO("C",SDT,SDU))
if SDU=""
QUIT
Begin DoDot:2
+6 SET SDCNT=$SELECT($PIECE(LSUB,"|",5)'="":$PIECE(LSUB,"|",5),1:"")
+7 FOR
SET SDCNT=$ORDER(APPO("C",SDT,SDU,SDCNT))
if SDCNT=""
QUIT
Begin DoDot:3
+8 SET SDID=APPO("C",SDT,SDU,SDCNT)
+9 DO REQGET^SDEC(.SDECY,,,,,SDID)
+10 if $GET(@SDECY@(1))=""
QUIT
+11 SET SDATA=@SDECY@(1)
+12 SET SDATA=$PIECE(SDATA,$CHAR(30),1)
+13 SET APPT=SDT_"||"_SDU_"|"_$$GET1^DIQ(200,SDU_",",.01)
+14 ;6
SET SDTMP="CONSULT"_U_$PIECE(SDATA,U,3)_U_$PIECE(SDATA,U,4)_U_U_U
+15 ;11
SET SDTMP=SDTMP_U_U_U_U_U
+16 ;18
SET SDTMP=SDTMP_U_APPT_U_$PIECE(SDATA,U,6)_U_$PIECE(SDATA,U,7)_U_U_$PIECE(SDATA,U,1)_U_U_(SDTOT+SDEC54+1)
+17 SET SDEC54=SDEC54+1
SET @SDECRET@(SDEC54)=SDTMP_$CHAR(30)
+18 KILL @SDECY
End DoDot:3
IF SDEC54'<MAXREC
if SDSUB=""
SET SDSUB=(SDTOT+SDEC54)_"|REQAP|"_SDT_"|"_SDU_"|"_SDCNT
QUIT
End DoDot:2
IF SDEC54'<MAXREC
if SDSUB=""
SET SDSUB=(SDTOT+SDEC54)_"|REQAP|"_SDT_"|"_SDU_"|"_SDCNT
QUIT
End DoDot:1
IF SDEC54'<MAXREC
if SDSUB=""
SET SDSUB=(SDTOT+SDEC54)_"|REQAP|"_SDT_"|"_SDU_"|"_SDCNT
QUIT
+19 QUIT
+20 ;
RECALL ;get RECALL REMINDERS data
+1 NEW SDECY,SDR,SDT,SDU
+2 SET SDT=$SELECT($PIECE(LSUB,"|",3)'="":$PIECE(LSUB,"|",3)-.0001,1:$PIECE(SDBEG,".",1))
+3 FOR
SET SDT=$ORDER(^SD(403.5,"AC",SDT))
if SDT'>0
QUIT
if $PIECE(SDT,".",1)>SDEND
QUIT
Begin DoDot:1
+4 IF USER'=""
SET SDU=USER
DO RECALL1
+5 IF USER=""
SET SDU=$SELECT($PIECE(LSUB,"|",4)'="":$PIECE(LSUB,"|",4)-1,1:0)
FOR
SET SDU=$ORDER(^SD(403.5,"AC",SDT,SDU))
if SDU'>0
QUIT
if (USER'="")&(SDU'=USER)
QUIT
DO RECALL1
IF SDEC54'<MAXREC
if SDSUB=""
SET SDSUB=(SDTOT+SDEC54)_"|REC|"_SDT_"|"_SDU_"|"_SDR
QUIT
End DoDot:1
IF SDEC54'<MAXREC
if SDSUB=""
SET SDSUB=(SDTOT+SDEC54)_"|REC|"_SDT_"|"_SDU_"|"_SDR
QUIT
+6 QUIT
RECALL1 ;
+1 SET SDR=$SELECT($PIECE(LSUB,"|",5)'="":$PIECE(LSUB,"|",5),1:0)
FOR
SET SDR=$ORDER(^SD(403.5,"AC",SDT,SDU,SDR))
if SDR'>0
QUIT
Begin DoDot:1
+2 SET SDECY=""
+3 DO RECIEN^SDEC(.SDECY,SDR)
+4 if $GET(@SDECY@(1))=""
QUIT
+5 SET WLDATA=@SDECY@(1)
+6 SET WLDATA=$PIECE(WLDATA,$CHAR(30),1)
+7 ;6
SET SDTMP="RECALL"_U_$PIECE(WLDATA,U,2)_U_$PIECE(WLDATA,U,3)_U_$PIECE(WLDATA,U,32)_U_$PIECE(WLDATA,U,22)_U_$PIECE(WLDATA,U,23)
+8 ;11
SET SDTMP=SDTMP_U_U_U_U_U
+9 ;18 ;alb/sat 642 null for DATE2
SET SDTMP=SDTMP_U_U_$PIECE(WLDATA,U,16)_U_$PIECE(WLDATA,U,17)_U_U_$PIECE(WLDATA,U,1)_U_U_(SDTOT+SDEC54+1)
+10 SET SDEC54=SDEC54+1
SET @SDECRET@(SDEC54)=SDTMP_$CHAR(30)
+11 KILL @SDECY
End DoDot:1
IF SDEC54'<MAXREC
if SDSUB=""
SET SDSUB=(SDTOT+SDEC54)_"|REC|"_SDT_"|"_SDU_"|"_SDR
QUIT
+12 QUIT
+13 ;
RECAPPS ;get recall appointments made ;alb/sat 642
+1 NEW APPT,SDU,SDID,SDCNT,SDATA,SDECY,SDT,SDTMP
+2 SET SDT=$SELECT($PIECE(LSUB,"|",3)'="":$PIECE(LSUB,"|",3),1:"")
+3 FOR
SET SDT=$ORDER(APPO("R",SDT))
if SDT=""
QUIT
Begin DoDot:1
+4 SET SDU=$SELECT($PIECE(LSUB,"|",4)'="":$PIECE(LSUB,"|",4),1:"")
+5 FOR
SET SDU=$ORDER(APPO("R",SDT,SDU))
if SDU=""
QUIT
Begin DoDot:2
+6 SET SDCNT=$SELECT($PIECE(LSUB,"|",5)'="":$PIECE(LSUB,"|",5),1:"")
+7 FOR
SET SDCNT=$ORDER(APPO("R",SDT,SDU,SDCNT))
if SDCNT=""
QUIT
Begin DoDot:3
+8 SET SDID=APPO("R",SDT,SDU,SDCNT)
+9 DO RECIEN^SDEC(.SDECY,SDID)
+10 if $GET(@SDECY@(1))=""
QUIT
+11 SET SDATA=@SDECY@(1)
+12 SET SDATA=$PIECE(SDATA,$CHAR(30),1)
+13 SET APPT=SDT_"||"_SDU_"|"_$$GET1^DIQ(200,SDU_",",.01)
+14 ;6
SET SDTMP="RECALL"_U_$PIECE(SDATA,U,2)_U_$PIECE(SDATA,U,3)_U_U_$PIECE(SDATA,U,22)_U_$PIECE(SDATA,U,23)
+15 ;11
SET SDTMP=SDTMP_U_U_U_U_U
+16 ;18
SET SDTMP=SDTMP_U_APPT_U_$PIECE(SDATA,U,16)_U_$PIECE(SDATA,U,17)_U_U_$PIECE(SDATA,U,1)_U_U_(SDTOT+SDEC54+1)
+17 SET SDEC54=SDEC54+1
SET @SDECRET@(SDEC54)=SDTMP_$CHAR(30)
+18 KILL @SDECY
End DoDot:3
IF SDEC54'<MAXREC
if SDSUB=""
SET SDSUB=(SDTOT+SDEC54)_"|RECAP|"_SDT_"|"_SDU_"|"_SDCNT
QUIT
End DoDot:2
IF SDEC54'<MAXREC
if SDSUB=""
SET SDSUB=(SDTOT+SDEC54)_"|RECAP|"_SDT_"|"_SDU_"|"_SDCNT
QUIT
End DoDot:1
IF SDEC54'<MAXREC
if SDSUB=""
SET SDSUB=(SDTOT+SDEC54)_"|RECAP|"_SDT_"|"_SDU_"|"_SDCNT
QUIT
+19 QUIT
+20 ;
DEMO ;get patient demographics
+1 NEW SDDEMO
+2 ;alb/sat 658 PDEMO moved to SDECU3
DO PDEMO^SDECU3(.SDDEMO,DFN)
+3 SET NAME=SDDEMO("NAME")
+4 QUIT
+5 ;
WLINIT ;
+1 NEW NAME,NAMEPART,DOB,GENDER,HRN,SSN,INSTIEN,INSTNAME
+2 NEW PRIGRP,ELIGIEN,ELIGNAME,SVCCONN,SVCCONNP,TYPEIEN
+3 NEW TYPENAME,PTPHONE,WLORIGDT,WLINST,WLINSTNM,WLTYPE
+4 NEW WLTEAM,WLPOS,WLSSIEN,WLSSNAME,WLCLIEN,WLCLNAME
+5 NEW WLUSER,WLUSRNM,WLPRIO,WLENPRI,WLREQBY,WLPROV
+6 NEW WLPROVNM,WLDAPTDT,WLCOMM,WLEESTAT,WLASD,WLMAR
+7 NEW WLMAI,WLMAN,WLPC
+8 QUIT
