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

SDEC54.m

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