SDECWL3 ;ALB/SAT - VISTA SCHEDULING RPCS ;JUN 21, 2017
;;5.3;Scheduling;**627,658,665**;Aug 13, 1993;Build 14
;
Q
;
WLHIDE(SDECY,DFN,WLCL) ;GET wait list entries in which the associated clinic's 'HIDE FROM DISPLAY?' field is 'YES'
;WLHIDE(SDECY,DFN,WLCL) external parameter tag in SDEC
; INPUT:
; DFN = (optional) Patient ID pointer to PATIENT file 2
; WLCL = (optional) Clinic ID pointer to SD WL CLINIC LOCATION
; RETURN:
; DFN
; ORIGDT = Originating Date
; TYPE = Wait List Type
; CLINIEN = Clinic IEN pointer to HOSPITAL LOCATION file 44
; WLCLNAME = WL SPECIFIC CLINIC
; USERIEN = Originating User
; USERNAME = Originating User name
; DATE1 = Date/Time Entered
; DAPTDT = Desired Date of appointment
; STATUS = Current Status
; OPEN CLOSED
N CLINIEN,DAPTDT,DATE1,ORIGDT,STATUS,TYPE,USERIEN,USERNAME,WLCLIEN,WLCLNAME
N SDI,SDCL,SDCL1,SDECI,SDDATA,INACTIVE,SDFIELDS,SDTMP,PTNAME
N WLIEN
S SDCL=""
S SDECI=0
S SDECY=$NA(^TMP("SDECWL3",$J,"WLHIDE"))
K @SDECY
S SDTMP="I00030DFN^T00030ORIGDT^T00030TYPE^T00030CLINIEN^T00030WLCLNAME^T00030USERIEN^"
S SDTMP=SDTMP_"T00030USERNAME^T00030DATE1^T00030DAPTDT^T00030STATUS^T00030PATIENTNAME"_$C(30)
S @SDECY@(SDECI)=SDTMP
S DFN=$G(DFN)
I DFN'="" I '$D(^DPT(DFN,0)) S @SDECY@(1)="-1^Invalid Patient ID." Q
S WLCL=$G(WLCL)
I +WLCL D
.S SDI=0 F S SDI=$O(^SDWL(409.32,"B",WLCL,SDI)) Q:SDI="" D ;Need to get the correct IEN
..S INACTIVE=$$GET1^DIQ(409.32,SDI_",",3,"I")
..I (INACTIVE'="")&($P(INACTIVE,".",1)'>$P($$NOW^XLFDT,".",1)) Q ;alb/sat 665
..S (SDCL,SDCL1)=$$GET1^DIQ(409.32,+SDI_",",.01,"I")
;I +WLCL,SDCL="" S @SDECY@(1)="-1^Invalid Clinic Location ID." Q
I +DFN D
.I 'WLCL S (SDCL,SDCL1)=0
.E S SDCL=WLCL-1
.F S SDCL=$O(^SDWL(409.3,"AD",DFN,SDCL)) Q:SDCL'>0 Q:(WLCL>0)&(WLCL'=SDCL) D
..Q:$P($G(^SC(SDCL,0)),U,26)'=1
..S WLIEN=0 F S WLIEN=$O(^SDWL(409.3,"AD",DFN,SDCL,WLIEN)) Q:WLIEN'>0 D GET1
G:DFN'="" XIT
S SDCL1=+SDCL
S SDCL=$S(+SDCL:SDCL-1,1:0) F S SDCL=$O(^SC("AF",1,SDCL)) Q:SDCL'>0 Q:(SDCL1>0)&(SDCL1'=SDCL) D
.S WLIEN=0 F S WLIEN=$O(^SDWL(409.3,"AE",SDCL,WLIEN)) Q:WLIEN'>0 D GET1
XIT ;
S @SDECY@(SDECI)=@SDECY@(SDECI)_$C(31)
Q
;
GET1 ;
K SDDATA
Q:$P($G(^SDWL(409.3,WLIEN,0)),U,17)="C"
S SDFIELDS=".01;1;4;8;8.5;9;9.5;22;23"
D GETS^DIQ(409.3,WLIEN,SDFIELDS,"IE","SDDATA")
S DFN=SDDATA(409.3,WLIEN_",",.01,"I") ;DFN
S PTNAME=$$GET1^DIQ(2,DFN,.01) ;NAME OF PT
S ORIGDT=SDDATA(409.3,WLIEN_",",1,"E") ;ORIGINATING DATE
S TYPE=SDDATA(409.3,WLIEN_",",4,"E") ;WAIT LIST TYPE
S CLINIEN=SDDATA(409.3,WLIEN_",",8.5,"I") ;CLINIC IEN
I CLINIEN="" D
.S WLCLIEN=SDDATA(409.3,WLIEN_",",8,"I")
.S CLINIEN=$$GET1^DIQ(409.32,WLCLIEN_",",.01,"I")
Q:CLINIEN=""
S WLCLNAME=$$GET1^DIQ(44,CLINIEN_",",.01) ;Clinic name
S USERIEN=SDDATA(409.3,WLIEN_",",9,"I") ;ORIGINATING USER
S USERNAME=SDDATA(409.3,WLIEN_",",9,"E") ;ORIGINATING USER name
S DATE1=SDDATA(409.3,WLIEN_",",9.5,"E") ;DATE/TIME ENTERED
S DAPTDT=SDDATA(409.3,WLIEN_",",22,"E") ;Desired Date of Appointment
S STATUS=SDDATA(409.3,WLIEN_",",23,"E") ;CURRENT STATUS
S SDTMP=DFN_U_ORIGDT_U_TYPE_U_CLINIEN_U_WLCLNAME_U_USERIEN_U_USERNAME
S SDTMP=SDTMP_U_DATE1_U_DAPTDT_U_STATUS_U_PTNAME
S SDECI=SDECI+1 S @SDECY@(SDECI)=SDTMP_$C(30)
Q
;
WLDEMO(STR,DFN) ;collect patient demographics and return in STR ;alb/sat 658
N SDDEMO
D PDEMO^SDECU3(.SDDEMO,DFN) ;alb/sat 658 PDEMO moved to SDECU3
S $P(STR,U,2)=SDDEMO("NAME")
S $P(STR,U,4)=SDDEMO("DOB")
S $P(STR,U,5)=SDDEMO("SSN")
S $P(STR,U,6)=SDDEMO("GENDER")
S $P(STR,U,27)=SDDEMO("HPHONE") ;alb/sat 658 change to HPHONE
S $P(STR,U,33)=SDDEMO("PRIGRP")
S $P(STR,U,34)=SDDEMO("ELIGIEN")
S $P(STR,U,35)=SDDEMO("ELIGNAME")
S $P(STR,U,36)=SDDEMO("SVCCONN")
S $P(STR,U,37)=SDDEMO("SVCCONNP")
S $P(STR,U,38)=SDDEMO("TYPEIEN")
S $P(STR,U,39)=SDDEMO("TYPENAME")
S $P(STR,U,45)=SDDEMO("PADDRES1")
S $P(STR,U,46)=SDDEMO("PADDRES2")
S $P(STR,U,47)=SDDEMO("PADDRES3")
S $P(STR,U,48)=SDDEMO("PCITY")
S $P(STR,U,49)=SDDEMO("PSTATE")
S $P(STR,U,50)=SDDEMO("PCOUNTRY")
S $P(STR,U,51)=SDDEMO("PZIP+4")
S $P(STR,U,63)=SDDEMO("HRN")
S $P(STR,U,64)=SDDEMO("BADADD")
S $P(STR,U,65)=SDDEMO("OPHONE")
S $P(STR,U,66)=SDDEMO("NOK")
S $P(STR,U,67)=SDDEMO("KNAME")
S $P(STR,U,68)=SDDEMO("KREL")
S $P(STR,U,69)=SDDEMO("KPHONE")
S $P(STR,U,70)=SDDEMO("KSTREET")
S $P(STR,U,71)=SDDEMO("KSTREET2")
S $P(STR,U,72)=SDDEMO("KSTREET3")
S $P(STR,U,73)=SDDEMO("KCITY")
S $P(STR,U,74)=SDDEMO("KSTATE")
S $P(STR,U,75)=SDDEMO("KZIP")
S $P(STR,U,76)=SDDEMO("NOK2")
S $P(STR,U,77)=SDDEMO("K2NAME")
S $P(STR,U,78)=SDDEMO("K2REL")
S $P(STR,U,79)=SDDEMO("K2PHONE")
S $P(STR,U,80)=SDDEMO("K2STREET")
S $P(STR,U,81)=SDDEMO("K2STREET2")
S $P(STR,U,82)=SDDEMO("K2STREET3")
S $P(STR,U,83)=SDDEMO("K2CITY")
S $P(STR,U,84)=SDDEMO("K2STATE")
S $P(STR,U,85)=SDDEMO("K2ZIP")
S $P(STR,U,86)=SDDEMO("PCOUNTY")
S $P(STR,U,87)=SDDEMO("PETH")
S $P(STR,U,88)=SDDEMO("PRACE")
S $P(STR,U,89)=SDDEMO("PMARITAL")
S $P(STR,U,90)=SDDEMO("PRELIGION")
S $P(STR,U,91)=SDDEMO("PTACTIVE")
S $P(STR,U,92)=SDDEMO("PTADDRESS1")
S $P(STR,U,93)=SDDEMO("PTADDRESS2")
S $P(STR,U,94)=SDDEMO("PTADDRESS3")
S $P(STR,U,95)=SDDEMO("PTCITY")
S $P(STR,U,96)=SDDEMO("PTSTATE")
S $P(STR,U,97)=SDDEMO("PTZIP")
S $P(STR,U,98)=SDDEMO("PTZIP+4")
S $P(STR,U,99)=SDDEMO("PTCOUNTRY")
S $P(STR,U,100)=SDDEMO("PTCOUNTY")
S $P(STR,U,101)=SDDEMO("PTPHONE")
S $P(STR,U,102)=SDDEMO("PTSTART")
S $P(STR,U,103)=SDDEMO("PTEND")
S $P(STR,U,104)=SDDEMO("PCELL")
S $P(STR,U,105)=SDDEMO("PPAGER")
S $P(STR,U,106)=SDDEMO("PEMAIL")
S $P(STR,U,107)=SDDEMO("PF_FFF")
S $P(STR,U,108)=SDDEMO("PF_VCD")
S $P(STR,U,109)=SDDEMO("PFNATIONAL")
S $P(STR,U,110)=SDDEMO("PFLOCAL")
S $P(STR,U,111)=SDDEMO("SUBGRP")
S $P(STR,U,112)=($P(STR,U,33)="GROUP 8")&(SDDEMO("SUBGRP")="g")
S $P(STR,U,113)=SDDEMO("SIMILAR")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDECWL3 6026 printed Dec 13, 2024@02:53:02 Page 2
SDECWL3 ;ALB/SAT - VISTA SCHEDULING RPCS ;JUN 21, 2017
+1 ;;5.3;Scheduling;**627,658,665**;Aug 13, 1993;Build 14
+2 ;
+3 QUIT
+4 ;
WLHIDE(SDECY,DFN,WLCL) ;GET wait list entries in which the associated clinic's 'HIDE FROM DISPLAY?' field is 'YES'
+1 ;WLHIDE(SDECY,DFN,WLCL) external parameter tag in SDEC
+2 ; INPUT:
+3 ; DFN = (optional) Patient ID pointer to PATIENT file 2
+4 ; WLCL = (optional) Clinic ID pointer to SD WL CLINIC LOCATION
+5 ; RETURN:
+6 ; DFN
+7 ; ORIGDT = Originating Date
+8 ; TYPE = Wait List Type
+9 ; CLINIEN = Clinic IEN pointer to HOSPITAL LOCATION file 44
+10 ; WLCLNAME = WL SPECIFIC CLINIC
+11 ; USERIEN = Originating User
+12 ; USERNAME = Originating User name
+13 ; DATE1 = Date/Time Entered
+14 ; DAPTDT = Desired Date of appointment
+15 ; STATUS = Current Status
+16 ; OPEN CLOSED
+17 NEW CLINIEN,DAPTDT,DATE1,ORIGDT,STATUS,TYPE,USERIEN,USERNAME,WLCLIEN,WLCLNAME
+18 NEW SDI,SDCL,SDCL1,SDECI,SDDATA,INACTIVE,SDFIELDS,SDTMP,PTNAME
+19 NEW WLIEN
+20 SET SDCL=""
+21 SET SDECI=0
+22 SET SDECY=$NAME(^TMP("SDECWL3",$JOB,"WLHIDE"))
+23 KILL @SDECY
+24 SET SDTMP="I00030DFN^T00030ORIGDT^T00030TYPE^T00030CLINIEN^T00030WLCLNAME^T00030USERIEN^"
+25 SET SDTMP=SDTMP_"T00030USERNAME^T00030DATE1^T00030DAPTDT^T00030STATUS^T00030PATIENTNAME"_$CHAR(30)
+26 SET @SDECY@(SDECI)=SDTMP
+27 SET DFN=$GET(DFN)
+28 IF DFN'=""
IF '$DATA(^DPT(DFN,0))
SET @SDECY@(1)="-1^Invalid Patient ID."
QUIT
+29 SET WLCL=$GET(WLCL)
+30 IF +WLCL
Begin DoDot:1
+31 ;Need to get the correct IEN
SET SDI=0
FOR
SET SDI=$ORDER(^SDWL(409.32,"B",WLCL,SDI))
if SDI=""
QUIT
Begin DoDot:2
+32 SET INACTIVE=$$GET1^DIQ(409.32,SDI_",",3,"I")
+33 ;alb/sat 665
IF (INACTIVE'="")&($PIECE(INACTIVE,".",1)'>$PIECE($$NOW^XLFDT,".",1))
QUIT
+34 SET (SDCL,SDCL1)=$$GET1^DIQ(409.32,+SDI_",",.01,"I")
End DoDot:2
End DoDot:1
+35 ;I +WLCL,SDCL="" S @SDECY@(1)="-1^Invalid Clinic Location ID." Q
+36 IF +DFN
Begin DoDot:1
+37 IF 'WLCL
SET (SDCL,SDCL1)=0
+38 IF '$TEST
SET SDCL=WLCL-1
+39 FOR
SET SDCL=$ORDER(^SDWL(409.3,"AD",DFN,SDCL))
if SDCL'>0
QUIT
if (WLCL>0)&(WLCL'=SDCL)
QUIT
Begin DoDot:2
+40 if $PIECE($GET(^SC(SDCL,0)),U,26)'=1
QUIT
+41 SET WLIEN=0
FOR
SET WLIEN=$ORDER(^SDWL(409.3,"AD",DFN,SDCL,WLIEN))
if WLIEN'>0
QUIT
DO GET1
End DoDot:2
End DoDot:1
+42 if DFN'=""
GOTO XIT
+43 SET SDCL1=+SDCL
+44 SET SDCL=$SELECT(+SDCL:SDCL-1,1:0)
FOR
SET SDCL=$ORDER(^SC("AF",1,SDCL))
if SDCL'>0
QUIT
if (SDCL1>0)&(SDCL1'=SDCL)
QUIT
Begin DoDot:1
+45 SET WLIEN=0
FOR
SET WLIEN=$ORDER(^SDWL(409.3,"AE",SDCL,WLIEN))
if WLIEN'>0
QUIT
DO GET1
End DoDot:1
XIT ;
+1 SET @SDECY@(SDECI)=@SDECY@(SDECI)_$CHAR(31)
+2 QUIT
+3 ;
GET1 ;
+1 KILL SDDATA
+2 if $PIECE($GET(^SDWL(409.3,WLIEN,0)),U,17)="C"
QUIT
+3 SET SDFIELDS=".01;1;4;8;8.5;9;9.5;22;23"
+4 DO GETS^DIQ(409.3,WLIEN,SDFIELDS,"IE","SDDATA")
+5 ;DFN
SET DFN=SDDATA(409.3,WLIEN_",",.01,"I")
+6 ;NAME OF PT
SET PTNAME=$$GET1^DIQ(2,DFN,.01)
+7 ;ORIGINATING DATE
SET ORIGDT=SDDATA(409.3,WLIEN_",",1,"E")
+8 ;WAIT LIST TYPE
SET TYPE=SDDATA(409.3,WLIEN_",",4,"E")
+9 ;CLINIC IEN
SET CLINIEN=SDDATA(409.3,WLIEN_",",8.5,"I")
+10 IF CLINIEN=""
Begin DoDot:1
+11 SET WLCLIEN=SDDATA(409.3,WLIEN_",",8,"I")
+12 SET CLINIEN=$$GET1^DIQ(409.32,WLCLIEN_",",.01,"I")
End DoDot:1
+13 if CLINIEN=""
QUIT
+14 ;Clinic name
SET WLCLNAME=$$GET1^DIQ(44,CLINIEN_",",.01)
+15 ;ORIGINATING USER
SET USERIEN=SDDATA(409.3,WLIEN_",",9,"I")
+16 ;ORIGINATING USER name
SET USERNAME=SDDATA(409.3,WLIEN_",",9,"E")
+17 ;DATE/TIME ENTERED
SET DATE1=SDDATA(409.3,WLIEN_",",9.5,"E")
+18 ;Desired Date of Appointment
SET DAPTDT=SDDATA(409.3,WLIEN_",",22,"E")
+19 ;CURRENT STATUS
SET STATUS=SDDATA(409.3,WLIEN_",",23,"E")
+20 SET SDTMP=DFN_U_ORIGDT_U_TYPE_U_CLINIEN_U_WLCLNAME_U_USERIEN_U_USERNAME
+21 SET SDTMP=SDTMP_U_DATE1_U_DAPTDT_U_STATUS_U_PTNAME
+22 SET SDECI=SDECI+1
SET @SDECY@(SDECI)=SDTMP_$CHAR(30)
+23 QUIT
+24 ;
WLDEMO(STR,DFN) ;collect patient demographics and return in STR ;alb/sat 658
+1 NEW SDDEMO
+2 ;alb/sat 658 PDEMO moved to SDECU3
DO PDEMO^SDECU3(.SDDEMO,DFN)
+3 SET $PIECE(STR,U,2)=SDDEMO("NAME")
+4 SET $PIECE(STR,U,4)=SDDEMO("DOB")
+5 SET $PIECE(STR,U,5)=SDDEMO("SSN")
+6 SET $PIECE(STR,U,6)=SDDEMO("GENDER")
+7 ;alb/sat 658 change to HPHONE
SET $PIECE(STR,U,27)=SDDEMO("HPHONE")
+8 SET $PIECE(STR,U,33)=SDDEMO("PRIGRP")
+9 SET $PIECE(STR,U,34)=SDDEMO("ELIGIEN")
+10 SET $PIECE(STR,U,35)=SDDEMO("ELIGNAME")
+11 SET $PIECE(STR,U,36)=SDDEMO("SVCCONN")
+12 SET $PIECE(STR,U,37)=SDDEMO("SVCCONNP")
+13 SET $PIECE(STR,U,38)=SDDEMO("TYPEIEN")
+14 SET $PIECE(STR,U,39)=SDDEMO("TYPENAME")
+15 SET $PIECE(STR,U,45)=SDDEMO("PADDRES1")
+16 SET $PIECE(STR,U,46)=SDDEMO("PADDRES2")
+17 SET $PIECE(STR,U,47)=SDDEMO("PADDRES3")
+18 SET $PIECE(STR,U,48)=SDDEMO("PCITY")
+19 SET $PIECE(STR,U,49)=SDDEMO("PSTATE")
+20 SET $PIECE(STR,U,50)=SDDEMO("PCOUNTRY")
+21 SET $PIECE(STR,U,51)=SDDEMO("PZIP+4")
+22 SET $PIECE(STR,U,63)=SDDEMO("HRN")
+23 SET $PIECE(STR,U,64)=SDDEMO("BADADD")
+24 SET $PIECE(STR,U,65)=SDDEMO("OPHONE")
+25 SET $PIECE(STR,U,66)=SDDEMO("NOK")
+26 SET $PIECE(STR,U,67)=SDDEMO("KNAME")
+27 SET $PIECE(STR,U,68)=SDDEMO("KREL")
+28 SET $PIECE(STR,U,69)=SDDEMO("KPHONE")
+29 SET $PIECE(STR,U,70)=SDDEMO("KSTREET")
+30 SET $PIECE(STR,U,71)=SDDEMO("KSTREET2")
+31 SET $PIECE(STR,U,72)=SDDEMO("KSTREET3")
+32 SET $PIECE(STR,U,73)=SDDEMO("KCITY")
+33 SET $PIECE(STR,U,74)=SDDEMO("KSTATE")
+34 SET $PIECE(STR,U,75)=SDDEMO("KZIP")
+35 SET $PIECE(STR,U,76)=SDDEMO("NOK2")
+36 SET $PIECE(STR,U,77)=SDDEMO("K2NAME")
+37 SET $PIECE(STR,U,78)=SDDEMO("K2REL")
+38 SET $PIECE(STR,U,79)=SDDEMO("K2PHONE")
+39 SET $PIECE(STR,U,80)=SDDEMO("K2STREET")
+40 SET $PIECE(STR,U,81)=SDDEMO("K2STREET2")
+41 SET $PIECE(STR,U,82)=SDDEMO("K2STREET3")
+42 SET $PIECE(STR,U,83)=SDDEMO("K2CITY")
+43 SET $PIECE(STR,U,84)=SDDEMO("K2STATE")
+44 SET $PIECE(STR,U,85)=SDDEMO("K2ZIP")
+45 SET $PIECE(STR,U,86)=SDDEMO("PCOUNTY")
+46 SET $PIECE(STR,U,87)=SDDEMO("PETH")
+47 SET $PIECE(STR,U,88)=SDDEMO("PRACE")
+48 SET $PIECE(STR,U,89)=SDDEMO("PMARITAL")
+49 SET $PIECE(STR,U,90)=SDDEMO("PRELIGION")
+50 SET $PIECE(STR,U,91)=SDDEMO("PTACTIVE")
+51 SET $PIECE(STR,U,92)=SDDEMO("PTADDRESS1")
+52 SET $PIECE(STR,U,93)=SDDEMO("PTADDRESS2")
+53 SET $PIECE(STR,U,94)=SDDEMO("PTADDRESS3")
+54 SET $PIECE(STR,U,95)=SDDEMO("PTCITY")
+55 SET $PIECE(STR,U,96)=SDDEMO("PTSTATE")
+56 SET $PIECE(STR,U,97)=SDDEMO("PTZIP")
+57 SET $PIECE(STR,U,98)=SDDEMO("PTZIP+4")
+58 SET $PIECE(STR,U,99)=SDDEMO("PTCOUNTRY")
+59 SET $PIECE(STR,U,100)=SDDEMO("PTCOUNTY")
+60 SET $PIECE(STR,U,101)=SDDEMO("PTPHONE")
+61 SET $PIECE(STR,U,102)=SDDEMO("PTSTART")
+62 SET $PIECE(STR,U,103)=SDDEMO("PTEND")
+63 SET $PIECE(STR,U,104)=SDDEMO("PCELL")
+64 SET $PIECE(STR,U,105)=SDDEMO("PPAGER")
+65 SET $PIECE(STR,U,106)=SDDEMO("PEMAIL")
+66 SET $PIECE(STR,U,107)=SDDEMO("PF_FFF")
+67 SET $PIECE(STR,U,108)=SDDEMO("PF_VCD")
+68 SET $PIECE(STR,U,109)=SDDEMO("PFNATIONAL")
+69 SET $PIECE(STR,U,110)=SDDEMO("PFLOCAL")
+70 SET $PIECE(STR,U,111)=SDDEMO("SUBGRP")
+71 SET $PIECE(STR,U,112)=($PIECE(STR,U,33)="GROUP 8")&(SDDEMO("SUBGRP")="g")
+72 SET $PIECE(STR,U,113)=SDDEMO("SIMILAR")
+73 QUIT
