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

SDECWL3.m

Go to the documentation of this file.
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