SDEC51.m

SDEC51 ;ALB/SAT,CT,LAB,MGD - VISTA SCHEDULING RPCS ;APR 14, 2023@11:58

 ;;5.3;Scheduling;**627,642,651,658,686,745,756,813,842**;Aug 13, 1993;Build 17

 ;

 ;Reference is made to ICR's #4837, #4557, #6185, and #6186

 Q

 ;

REQGET(SDECY,SDBEG,SDEND,MAXREC,LASTSUB,SDGMR) ; GET entries that are not SCHEDULED.

REQGETA ;

 N PADDRES1,PADDRES2,PADDRES3,PCITY,PSTATE,PCOUNTRY,PTPHONE,PZIP4

 N SDECI,SDI,SDJ,SDREASON,SDREC,SDRECL,SDRPA,SDRPA0,SDTMP,SDWP,X,Y,%DT

 N SDCNT,SDCAN,SDCDC,SDCANF,SDCSTOP,SDSCHED,SDSCHEDF,SDSENS,SDSTAT,SDSTATF,SDDONE

 N DIC,ELIGIEN,ELIGNAME,GAF,PRIGRP,SVCCONN,SVCCONNP,TYPEIEN,TYPENAME

 N SDDEMO,SDNOCHK,SDSUB

 N DOB,GENDER,HRN,INSTIEN,INSTNAME,NAME,SSN,SVVCCONN

 S (SDNOCHK,SDSUB)=""

 S SDECI=0

 K ^TMP("SDEC",$J)

 S SDECY="^TMP(""SDEC"","_$J_")"

 ; data header

 D HDR

 S (SDCANF,SDSCHEDF)=0

 S SDREC=$$GETIEN("RECEIVED")

 I SDREC="" D ERR1^SDECERR(-1,"REQUEST ACTION TYPES file does not have an entry of RECEIVED.",.SDECI,SDECY) Q

 S SDSCHED=$$GETIEN("SCHEDULED")

 I SDSCHED="" D ERR1^SDECERR(-1,"REQUEST ACTION TYPES file does not have an entry of SCHEDULED.",.SDECI,SDECY) Q

 S SDSTAT=$$GETIEN("STATUS CHANGE")

 S SDCAN=$$GETIEN("CANCELLED")

 S SDDONE=$$GETIEN("COMPLETE/UPDATE")

 S SDCDC=$$GETIEN("DISCONTINUED")

 ;validate SDBEG (optional)

 S SDBEG=$G(SDBEG)

 I $G(SDBEG)'="" S %DT="" S X=$P($G(SDBEG),"@",1) D ^%DT S SDBEG=Y I Y=-1 S SDBEG=$$FMADD^XLFDT($P($$NOW^XLFDT,".",1),-1825)

 I $G(SDBEG)="" S SDBEG=$$FMADD^XLFDT($P($$NOW^XLFDT,".",1),-1825)

 ;validate SDEND (optional)

 S SDEND=$G(SDEND)

 I SDEND'="" S %DT="" S X=$P($G(SDEND),"@",1) D ^%DT S SDEND=Y I Y=-1 S SDEND=$$FMADD^XLFDT($P($$NOW^XLFDT,".",1),-90)

 I SDEND="" S SDEND=$$FMADD^XLFDT($P($$NOW^XLFDT,".",1),-90)

 ;validate SDGMR (optional)

 S SDGMR=$G(SDGMR)

 I SDGMR'="" I '$D(^GMR(123,+SDGMR,0)) D ERR1^SDECERR(-1,"Invalid Request/Consultation ID.",.SDECI,SDECY) Q   ;ICR 4837

 I SDGMR'="" S SDNOCHK=1 D REQGET1 G REQX

 ;validate MAXREC (optional)

 S MAXREC=+$G(MAXREC)

 I 'MAXREC S MAXREC=9999999

 ;validate LASTSUB (optional)

 S LASTSUB=$G(LASTSUB)

 S SDCNT=0

 S SDJ=$S($P(LASTSUB,"|",1)'="":$P(LASTSUB,"|",1),1:(SDBEG-1)_".2359")

 N SDJ,SDJ1,SD90,SVC

 N %DT,X,Y

 N DRQ,OSACT,OSPEND,SDGMR,STAT

 S OSACT=$O(^ORD(100.01,"B","ACTIVE",0))

 S OSPEND=$O(^ORD(100.01,"B","PENDING",0))

 S SDECI=$G(SDECI,0)

 S SVC=$S($P(LASTSUB,"|",1)'="":$P(LASTSUB,"|",1)-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(LASTSUB,"|",2)'="")&($P(LASTSUB,"|",2)'=STAT)

 ..S DRQ=$S($P(LASTSUB,"|",3)'="":$P(LASTSUB,"|",3)-.0001,1:SDBEG-1)

 ..F  S DRQ=$O(^GMR(123,"AE",SVC,STAT,DRQ)) Q:DRQ=""  Q:$P(DRQ,".",1)>SDEND  D  Q:SDECI>(MAXREC-1)

 ...S SDGMR=$S($P(LASTSUB,"|",4)'="":$P(LASTSUB,"|",4),1:0)

 ...S LASTSUB=""

 ...F  S SDGMR=$O(^GMR(123,"AE",SVC,STAT,DRQ,SDGMR)) Q:SDGMR=""  D REQGET1 I SDECI>(MAXREC-1) S SDSUB=SVC_"|"_STAT_"|"_DRQ_"|"_SDGMR Q

REQX ;

 S SDTMP=@SDECY@(SDECI) S SDTMP=$P(SDTMP,$C(30),1)

 S:$G(SDSUB)'="" $P(SDTMP,U,40)=SDSUB

 S @SDECY@(SDECI)=SDTMP_$C(30,31)

 Q

HDR ;Get the header information

 ;              1                 2           3         4

 S SDTMP="T00020CONSULTIEN^T00020ORIGDT^T00020DFN^T00030NAME"

 ;                     5                6             7              8                     9

 S SDTMP=SDTMP_"^T00030TO_SERVICE^T00010CLINIEN^T00030CLINNAME^T00030DATE_OF_REQUEST^T00030PRIO"

 ;                     10            11             12            13

 S SDTMP=SDTMP_"^T00030USERIEN^T00030USERNAME^T00030PROVIEN^T00030PROVNAME"

 ;                     14                 15                        16         17

 S SDTMP=SDTMP_"^T00030REQUEST_TYPE^T00030SERVICE_RENDERED_AS^T00100COMM^T00500REQ_PROC_ACT"

 ;                     18        19        20        21           22            23

 S SDTMP=SDTMP_"^T00030HRN^T00030DOB^T00030SSN^T00030GENDER^T00030INSTIEN^T00030INSTNAME"

 ;                     24           25            26             27            28

 S SDTMP=SDTMP_"^T00030PRIGRP^T00030ELIGIEN^T00030ELIGNAME^T00030SVCCONN^T00030SVCCONNP"

 ;                     29            30             31             32             33

 S SDTMP=SDTMP_"^T00030TYPEIEN^T00030TYPENAME^T00030PADDRES1^T00030PADDRES2^T00030PADDRES3"

 ;                     34          35           36             37          38      39             40

 S SDTMP=SDTMP_"^T00030PCITY^T00030PSTATE^T00030PCOUNTRY^T00030PZIP4^T00030GAF^T00100SENSITIVE^T00030LASTSUB"

 ;                     41         42            43            44          45           46         47

 S SDTMP=SDTMP_"^T00100STOP^T00030PTPHONE^T00030URGENCY^T00030PRACE^T00030PRACEN^T00030PETH^T00030PETHN"

 ;                     48            49

 S SDTMP=SDTMP_"^T00030PRHBLOC^T00030EARLIEST"

 S SDTMP=SDTMP_"^T00030BADADD^T00030OPHONE^T00030NOK^T00030KNAME^T00030KREL^T00030KPHONE"   ;55

 S SDTMP=SDTMP_"^T00030KSTREET^T00030KSTREET2^T00030KSTREET3^T00030KCITY^T00030KSTATE^T00030KZIP"   ;61

 S SDTMP=SDTMP_"^T00030NOK2^T00030K2NAME^T00030K2REL^T00030K2PHONE"  ;65

 S SDTMP=SDTMP_"^T00030K2STREET^T00030K2STREET2^T00030K2STREET3^T00030K2CITY^T00030K2STATE^T00030K2ZIP^T00030PCOUNTY"  ;72

 S SDTMP=SDTMP_"^T00030PMARITAL^T00030PRELIGION"  ;74

 S SDTMP=SDTMP_"^T00030PTACTIVE^T00030PTADDRESS1^T00030PTADDRESS2PTADDRESS3^T00030^T00030PTCITY^T00030PTSTATE^T00030PTZIP^T00030PTZIP+4"  ;82

 S SDTMP=SDTMP_"^T00030PTCOUNTRY^T00030PTCOUNTY^T00030PTPHONE^T00030PTSTART^T00030PTEND^T00030PCELL^T00030PPAGER^T00030PEMAIL"  ;90

 S SDTMP=SDTMP_"^T00030PF_FFF^T00030PF_VCD^T00030PFNATIONAL^T00030PFLOCAL^T00030SUBGRP^T00030CAT8G^T01000SIMILAR"  ;97

 S SDTMP=SDTMP_"^T00030CPHONE^T00030CLET"  ;99  added call phone & letter  *745  5/14/2020

 S SDTMP=SDTMP_"^T00030COVID_PRIORITY" ;*756

 S SDTMP=SDTMP_"^T00030CEMAIL^T00030CTEXT^T00030CSEC"  ;101^102^103 *813

 S @SDECY@(SDECI)=SDTMP_$C(30)

 Q

GETONE(SDECY,SDGMR) ;Get one specific consult

 ;              1                 2           3         4

 N PADDRES1,PADDRES2,PADDRES3,PCITY,PSTATE,PCOUNTRY,PZIP4

 N SDECI,SDI,SDJ,SDREASON,SDREC,SDRECL,SDRPA,SDRPA0,SDTMP,SDWP,X,Y,%DT

 N SDCNT,SDCAN,SDCDC,SDCANF,SDCSTOP,SDSCHED,SDSCHEDF,SDSENS,SDSTAT,SDSTATF,SDDONE

 N ELIGIEN,ELIGNAME,GAF,PRIGRP,SVCCONN,SVCCONNP,TYPEIEN,TYPENAME

 N SDDEMO,SDSUB,SDCON

 N DOB,GENDER,HRN,INSTIEN,INSTNAME,NAME,SSN,SVVCCONN

 N PRACE,PRACEN,PETH,PETHN,CLIEN,CLNAME

 S SDSUB=""

 S SDECI=0

 K ^TMP("SDEC",$J)

 S SDECY="^TMP(""SDEC"","_$J_")"

 D HDR

 S (SDCANF,SDSCHEDF)=0

 S SDREC=$$GETIEN("RECEIVED")

 I SDREC="" D ERR1^SDECERR(-1,"REQUEST ACTION TYPES file does not have an entry of RECEIVED.",.SDECI,SDECY) Q

 S SDSCHED=$$GETIEN("SCHEDULED")

 I SDSCHED="" D ERR1^SDECERR(-1,"REQUEST ACTION TYPES file does not have an entry of SCHEDULED.",.SDECI,SDECY) Q

 S SDSTAT=$$GETIEN("STATUS CHANGE")

 S SDCAN=$$GETIEN("CANCELLED")

 S SDDONE=$$GETIEN("COMPLETE/UPDATE")

 S SDCDC=$$GETIEN("DISCONTINUED")

 D REQGET1

 Q

REQGET1 ;

 N SDCL,SDGMR0,SDDATA,SDSER,SDSTOP,SIEN,STOP,IN,PRHBLOC

 N PRIO,DFN ;

 S SDRECL="",SDSTOP=""

 S (SDCANF,SDSCHEDF,SDSTATF)=0

 S SDCL=$P($G(^GMR(123,+SDGMR,0)),U,6)   ;ICR 4837

 I SDCL'="",$$GET1^DIQ(44,SDCL_",",50.01,"I")=1 Q  ;check OOS?

 S PRHBLOC=$S($$GET1^DIQ(44,+SDCL_",",2500,"I")="Y":1,1:0)

 S SDGMR0=$G(^GMR(123,SDGMR,0))   ;ICR 4837 states 'Zero node read into variable'

 S IN=$P(SDGMR0,U,18)   ;$$GET1^DIQ(123,SDGMR_",",14)

 S SDSER=$P(SDGMR0,U,5)

 I +SDSER D

 .S SIEN=0 F  S SIEN=$O(^GMR(123.5,SDSER,688,SIEN)) Q:'+SIEN  D

 ..S STOP=$G(^GMR(123.5,SDSER,688,SIEN,0))   ;ICR 4557

 ..I SDSTOP="" S SDSTOP=STOP

 ..E  S SDSTOP=SDSTOP_"|"_STOP

 S DFN=$$GET1^DIQ(123,SDGMR_",",.02,"I")

 Q:DFN=""

 ;

 I '$G(SDNOCHK) Q:$$REQCHK(.SDRECL,SDGMR,DFN)

 ;

 I 1 D

 .;get REASON FOR REQUEST wp text

 .K SDWP

 .S X=$$GET1^DIQ(123,SDGMR_",",20,"","SDWP")

 .;collect demographics

 .D PDEMO^SDECU3(.SDDEMO,DFN)   ;alb/sat 658 PDEMO moved to SDECU3

 .S NAME=SDDEMO("NAME")

 .S DOB=SDDEMO("DOB")

 .S GENDER=SDDEMO("GENDER")

 .S HRN=SDDEMO("HRN")

 .S SSN=SDDEMO("SSN")

 .S INSTIEN=SDDEMO("INSTIEN")

 .S INSTNAME=SDDEMO("INSTNAME")

 .S PRIGRP=SDDEMO("PRIGRP")       ;24

 .S ELIGIEN=SDDEMO("ELIGIEN")     ;25

 .S ELIGNAME=SDDEMO("ELIGNAME")   ;26

 .S SVVCCONN=SDDEMO("SVCCONN")    ;27

 .S SVCCONNP=SDDEMO("SVCCONNP")   ;28

 .S TYPEIEN=SDDEMO("TYPEIEN")     ;29

 .S TYPENAME=SDDEMO("TYPENAME")   ;30

 .S PADDRES1=SDDEMO("PADDRES1")   ;31   - Patient Address line 1

 .S PADDRES2=SDDEMO("PADDRES2")   ;32   - Patient Address line 2

 .S PADDRES3=SDDEMO("PADDRES3")   ;33   - Patient Address line 3

 .S PCITY=SDDEMO("PCITY")         ;34   - Patient City

 .S PSTATE=SDDEMO("PSTATE")       ;35   - Patient state name

 .S PCOUNTRY=SDDEMO("PCOUNTRY")   ;36   - Patient country name

 .S PZIP4=SDDEMO("PZIP+4")        ;37   - Patient Zip+4

 .S PTPHONE=SDDEMO("HPHONE")      ;42   - Patient phone

 .S GAF=$$GAF^SDECU2(DFN)         ;38

 .S SDSENS=$$PTSEC^SDECUTL(DFN)   ;39

 .S CLIEN=$$GET1^DIQ(123,SDGMR_",",2,"I") S:CLIEN="" CLIEN=$$GET1^DIQ(123,SDGMR_",",.05,"I")

 .S CLNAME=$$GET1^DIQ(123,SDGMR_",",2) S:CLNAME="" CLNAME=$$GET1^DIQ(123,SDGMR_",",.05)

 .D RACELST^SDECU2(DFN,.PRACE,.PRACEN)

 .D ETH^SDECU2(DFN,.PETH,.PETHN)   ;get ethnicity

 .S PRIO=$$PRIO^SDEC51A(SDGMR)

 .;       1         2                                     3                  4

 .S SDTMP=SDGMR_"^"_$$GET1^DIQ(123,SDGMR_",",.01,"I")_"^"_$P(SDGMR0,U,2)_"^"_$$GET1^DIQ(123,SDGMR_",",.02)

 .;                 5                               6                                   7                               8

 .S SDTMP=SDTMP_"^"_$$GET1^DIQ(123,SDGMR_",",1)_"^"_CLIEN_"^"_CLNAME_"^"_$$GET1^DIQ(123,SDGMR_",",3,"I") ;*745 - lab- changes to clinic name for IFCs

 .;                 9        10                                  11                              12

 .S SDTMP=SDTMP_"^"_PRIO_"^"_$$GET1^DIQ(123,SDGMR_",",7,"I")_"^"_$$GET1^DIQ(123,SDGMR_",",7)_"^"_$P(SDGMR0,U,14)

 .;                 13                               14                               15

 .S SDTMP=SDTMP_"^"_$$GET1^DIQ(123,SDGMR_",",10)_"^"_$$GET1^DIQ(123,SDGMR_",",13)_"^"_$$GET1^DIQ(123,SDGMR_",",14)

 .;                 16     17

 .S SDTMP=SDTMP_"^"_""_"^"_SDRECL

 .;               18   19    20    21       22        23

 .S SDTMP=SDTMP_U_""_U_DOB_U_SSN_U_GENDER_U_INSTIEN_U_INSTNAME    ;23

 .;               24       25        26         27         28

 .S SDTMP=SDTMP_U_PRIGRP_U_ELIGIEN_U_ELIGNAME_U_SVVCCONN_U_SVCCONNP   ;28

 .;               29        30         31         32         33

 .S SDTMP=SDTMP_U_TYPEIEN_U_TYPENAME_U_PADDRES1_U_PADDRES2_U_PADDRES3 ;33

 .;               34      35       36         37      38      39

 .S SDTMP=SDTMP_U_PCITY_U_PSTATE_U_PCOUNTRY_U_PZIP4_U_GAF_U_SDSENS    ;39

 .S SDTMP=SDTMP_U_U_SDSTOP_U_PTPHONE_U_$$GET1^DIQ(123,SDGMR_",",5,"I")  ;save the 40th position for LASTSUB if it is to be returned

 .S SDTMP=SDTMP_U_PRACE_U_PRACEN_U_PETH_U_PETHN_U_PRHBLOC_U_$$GET1^DIQ(123,SDGMR_",",17,"I")   ;49

 .S $P(SDTMP,U,50)=SDDEMO("BADADD")

 .S $P(SDTMP,U,51)=SDDEMO("OPHONE")

 .S $P(SDTMP,U,52)=SDDEMO("NOK")

 .S $P(SDTMP,U,53)=SDDEMO("KNAME")

 .S $P(SDTMP,U,54)=SDDEMO("KREL")

 .S $P(SDTMP,U,55)=SDDEMO("KPHONE")

 .S $P(SDTMP,U,56)=SDDEMO("KSTREET")

 .S $P(SDTMP,U,57)=SDDEMO("KSTREET2")

 .S $P(SDTMP,U,58)=SDDEMO("KSTREET3")

 .S $P(SDTMP,U,59)=SDDEMO("KCITY")

 .S $P(SDTMP,U,60)=SDDEMO("KSTATE")

 .S $P(SDTMP,U,61)=SDDEMO("KZIP")

 .S $P(SDTMP,U,62)=SDDEMO("NOK2")

 .S $P(SDTMP,U,63)=SDDEMO("K2NAME")

 .S $P(SDTMP,U,64)=SDDEMO("K2REL")

 .S $P(SDTMP,U,65)=SDDEMO("K2PHONE")

 .S $P(SDTMP,U,66)=SDDEMO("K2STREET")

 .S $P(SDTMP,U,67)=SDDEMO("K2STREET2")

 .S $P(SDTMP,U,68)=SDDEMO("K2STREET3")

 .S $P(SDTMP,U,69)=SDDEMO("K2CITY")

 .S $P(SDTMP,U,70)=SDDEMO("K2STATE")

 .S $P(SDTMP,U,71)=SDDEMO("K2ZIP")

 .S $P(SDTMP,U,72)=SDDEMO("PCOUNTY")

 .S $P(SDTMP,U,73)=SDDEMO("PMARITAL")

 .S $P(SDTMP,U,74)=SDDEMO("PRELIGION")

 .S $P(SDTMP,U,75)=SDDEMO("PTACTIVE")

 .S $P(SDTMP,U,76)=SDDEMO("PTADDRESS1")

 .S $P(SDTMP,U,77)=SDDEMO("PTADDRESS2")

 .S $P(SDTMP,U,78)=SDDEMO("PTADDRESS3")

 .S $P(SDTMP,U,79)=SDDEMO("PTCITY")

 .S $P(SDTMP,U,80)=SDDEMO("PTSTATE")

 .S $P(SDTMP,U,81)=SDDEMO("PTZIP")

 .S $P(SDTMP,U,82)=SDDEMO("PTZIP+4")

 .S $P(SDTMP,U,83)=SDDEMO("PTCOUNTRY")

 .S $P(SDTMP,U,84)=SDDEMO("PTCOUNTY")

 .S $P(SDTMP,U,85)=SDDEMO("PTPHONE")

 .S $P(SDTMP,U,86)=SDDEMO("PTSTART")

 .S $P(SDTMP,U,87)=SDDEMO("PTEND")

 .S $P(SDTMP,U,88)=SDDEMO("PCELL")

 .S $P(SDTMP,U,89)=SDDEMO("PPAGER")

 .S $P(SDTMP,U,90)=SDDEMO("PEMAIL")

 .S $P(SDTMP,U,91)=SDDEMO("PF_FFF")

 .S $P(SDTMP,U,92)=SDDEMO("PF_VCD")

 .S $P(SDTMP,U,93)=SDDEMO("PFNATIONAL")

 .S $P(SDTMP,U,94)=SDDEMO("PFLOCAL")

 .S $P(SDTMP,U,95)=SDDEMO("SUBGRP")

 .S $P(SDTMP,U,96)=(PRIGRP="GROUP 8")&(SDDEMO("SUBGRP")="g")

 .S $P(SDTMP,U,97)=SDDEMO("SIMILAR")

 .S SDCON=$$CALLCON^SDECAR1A(DFN,SDGMR)  ; SDECALL_U_SDECLET

 .S $P(SDTMP,U,98)=$P(SDCON,U,1)

 .S $P(SDTMP,U,99)=$P(SDCON,U,2)

 .S $P(SDTMP,U,100)=$$PRIORITY(SDGMR) ;*756 most recent covid-19 priority

 .S $P(SDTMP,U,101)=$P(SDCON,U,3)

 .S $P(SDTMP,U,102)=$P(SDCON,U,4)

 .S $P(SDTMP,U,103)=$P(SDCON,U,5)

 .S SDECI=SDECI+1 S @SDECY@(SDECI)=SDTMP_$C(30)

 Q

 ;

REQCHK(SDRECL,SDGMR,DFN) ;alb/sat 658 - new rules for consult check

 N CPRSTAT,IFC,OSACT,OSPEND

 Q:'$D(^GMR(123,+$G(SDGMR),0)) 1

 S OSACT=$O(^ORD(100.01,"B","ACTIVE",0))

 S OSPEND=$O(^ORD(100.01,"B","PENDING",0))

 S CPRSTAT=$$GET1^DIQ(123,SDGMR_",",8,"I")

 Q:'((CPRSTAT=OSACT)!(CPRSTAT=OSPEND)) 1

 S IFC=$$GET1^DIQ(123,SDGMR,.125,"I")

 Q:IFC="P" 1

 Q 0

REQCHK1(SDRECL,SDGMR,DFN) ; OLD

 N CPRSTAT,X,X1,X2   ;alb/sat 651

 N SDCAN,SDCANF,SDCDC,SDDONE,SDES,SDESF,SDFD,SDPDC,SDRPA,SDRPA0,SDSCHED,SDSCHEDF,SDSER,SDSTAT,SDSTATF

 N SDNOS     ;alb/sat 651

 S SDPDC=$O(^ORD(100.01,"B","DISCONTINUED",0))

 S CPRSTAT=$$GET1^DIQ(123,SDGMR_",",8,"I")   ;alb/sat 651 - set new CPRSTAT var

 Q:CPRSTAT=SDPDC 1   ;don't return this entry if CPRS STATUS is DISCONTINUED ;alb/sat 651 - use CPRSTAT instead of GET1^DIQ

 S SDFD=$P($$GET1^DIQ(123,SDGMR_",",.01,"I"),".",1)   ;alb/sat 651 - get FILE ENTRY DATE

 ;**Removed below line alb/jsm 658 - Consults to be displayed in the RM Grid regardless of the request date**

 S SDSCHED=$$GETIEN("SCHEDULED")      ;$O(^GMR(123.1,"B","SCHEDULED",0))

 S SDSTAT=$$GETIEN("STATUS CHANGE")   ;$O(^GMR(123.1,"B","STATUS CHANGE",0))

 S SDCAN=$$GETIEN("CANCELLED")        ;$O(^GMR(123.1,"B","CANCELLED",0))

 S SDDONE=$$GETIEN("COMPLETE/UPDATE") ;$O(^GMR(123.1,"B","COMPLETE/UPDATE",0))

 S SDCDC=$$GETIEN("DISCONTINUED")     ;$O(^GMR(123.1,"B","DISCONTINUED",0))

 S SDES=$$GETIEN("EDIT/RESUBMITTED")

 S SDSER=$$GET1^DIQ(123,SDGMR_",",1,"I")   ;ICR 6185

 S DFN=$G(DFN) I '+DFN S DFN=$$GET1^DIQ(123,SDGMR_",",.02,"I")   ;ICR 6185

 S SDRECL=$G(SDRECL)

 S (SDCANF,SDESF,SDSCHEDF,SDSTATF)=0

 ;alb/sat 651 - start

 I CPRSTAT=13 D  G REQCHKX     ;cancel/no-show  ;13 is cancel - see A+7^SDCNSLT SD*5.3*627

 .S SDCANF=1

 .S SDNOS=$O(^GMR(123,SDGMR,40,":"),-1) Q:'+SDNOS       ;ICR 6185

 .S SDNOS=$O(^GMR(123,SDGMR,40,SDNOS),-1) Q:'+SDNOS

 .S X2=$P($G(^GMR(123,SDGMR,40,SDNOS,0)),U),X1=DT D ^%DTC Q:X'=""&(X>180)   ;ICR 6185

 .I $$FINDTXT^SDEC51A(SDGMR,SDNOS) D

 ..S SDCANF=0

 ..S:$L($G(SDRECL))<225 SDRECL=SDNOS_";;"_$$GET1^DIQ(123.02,SDNOS_","_SDGMR_",",.01,"E")_";;"_SDCAN_$S(SDRECL'="":"|"_SDRECL,1:"")

 ;alb/sat 651 - end

 S SDRPA=9999999 F  S SDRPA=$O(^GMR(123,SDGMR,40,SDRPA),-1) Q:SDRPA'>0  D  Q:SDCANF=1  Q:SDSCHEDF=1  Q:SDESF=1   ;ICR 6185

 .K SDDATA

 .D GETS^DIQ(123.02,SDRPA_","_SDGMR_",",".01;1;2;4","IE","SDDATA")   ;ICR 6185

 .S SDRPA0=SDDATA(123.02,SDRPA_","_SDGMR_",",1,"I")  ;  $G(^GMR(123,SDGMR,40,SDRPA,0))

 .I SDRPA0'=SDSCHED,SDRPA0'=SDSTAT,SDRPA0'=SDCAN,SDRPA0'=SDDONE,SDRPA0'=SDCDC,SDRPA0'=SDES Q  ;SDRECL is getting too long; only watch the ones we need

 .I (SDRPA0=SDCAN)!(SDRPA0=SDDONE)!(SDRPA0=SDCDC) S SDCANF=1 Q    ;skip completed consults/mgh

 .I SDRPA0=SDES S SDESF=1 Q

 .I SDRPA0=SDSCHED,SDSTATF'=1,$$SDCHED^SDEC51A(DFN,SDDATA(123.02,SDRPA_","_SDGMR_",",2,"I"),SDSER) S SDSCHEDF=1 Q

 .I SDRPA0=SDSTAT,$$FINDTXT^SDEC51A(SDGMR,SDRPA) S SDSTATF=1

 .S:$L($G(SDRECL))<225 SDRECL=SDRPA_";;"_SDDATA(123.02,SDRPA_","_SDGMR_",",.01,"E")_";;"_SDRPA0_$S(SDRECL'="":"|"_SDRECL,1:"")

REQCHKX ; exit  ;alb/sat 651 - add REQCHKX tag

 K SDDATA

 Q:SDSCHEDF SDSCHEDF

 Q:SDCANF SDCANF

 Q:SDESF 0

 Q 0

 ;

GETIEN(NAME) ;get ID from REQUEST ACTION TYPES file 123.1   ;ICR 6186

 N DIC,X,Y

 S DIC=123.1

 S DIC(0)="BO"

 S X=NAME

 D ^DIC

 I Y=-1 Q ""

 Q $P(Y,U,1)

PRIORITY(GRMIEN) ;get priority from CONSULT activity (new tag *756)

 ;Input: GRMIEN = IEN of the REQUEST/CONSUTL (#123)

 ;returns: last priority entered into the consult activity

 ;

 N SDTOT,SDERR,SDACTDA,SDIDX,SDIDX2,SDPFND,PRITY

 S SDTOT=$P($G(^GMR(123,GRMIEN,40,0)),"^",4)

 ; get all activity for ien

 D GETS^DIQ(123,GRMIEN,"40*",,"SDACTDA","SDERR")

 S SDPFND=0

 F SDIDX=SDTOT:-1:1 Q:SDPFND=1  D

 .S SDIDX2=""

 .F  S SDIDX2=$O(SDACTDA(123.02,SDIDX_","_GRMIEN_",",5,SDIDX2)) Q:(SDIDX2="")!(SDPFND)  D

 ..I $G(SDACTDA(123.02,SDIDX_","_GRMIEN_",",5,SDIDX2))["COVID-19 Priority" D

 ... S PRITY=$P($G(SDACTDA(123.02,SDIDX_","_GRMIEN_",",5,SDIDX2)),"-COVID-19 Priority",1)

 ... S PRITY=$E(PRITY,$L(PRITY)-2,$L(PRITY))

 ... S SDPFND=1

 Q $G(PRITY)

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---SDEC51   17321     printed  Mar 13, 2025@21:55:43                                                                                                                                                                                                     Page 2

SDEC51    ;ALB/SAT,CT,LAB,MGD - VISTA SCHEDULING RPCS ;APR 14, 2023@11:58

 +1       ;;5.3;Scheduling;**627,642,651,658,686,745,756,813,842**;Aug 13, 1993;Build 17

 +2       ;

 +3       ;Reference is made to ICR's #4837, #4557, #6185, and #6186

 +4        QUIT 

 +5       ;

REQGET(SDECY,SDBEG,SDEND,MAXREC,LASTSUB,SDGMR) ; GET entries that are not SCHEDULED.

REQGETA   ;

 +1        NEW PADDRES1,PADDRES2,PADDRES3,PCITY,PSTATE,PCOUNTRY,PTPHONE,PZIP4

 +2        NEW SDECI,SDI,SDJ,SDREASON,SDREC,SDRECL,SDRPA,SDRPA0,SDTMP,SDWP,X,Y,%DT

 +3        NEW SDCNT,SDCAN,SDCDC,SDCANF,SDCSTOP,SDSCHED,SDSCHEDF,SDSENS,SDSTAT,SDSTATF,SDDONE

 +4        NEW DIC,ELIGIEN,ELIGNAME,GAF,PRIGRP,SVCCONN,SVCCONNP,TYPEIEN,TYPENAME

 +5        NEW SDDEMO,SDNOCHK,SDSUB

 +6        NEW DOB,GENDER,HRN,INSTIEN,INSTNAME,NAME,SSN,SVVCCONN

 +7        SET (SDNOCHK,SDSUB)=""

 +8        SET SDECI=0

 +9        KILL ^TMP("SDEC",$JOB)

 +10       SET SDECY="^TMP(""SDEC"","_$JOB_")"

 +11      ; data header

 +12       DO HDR

 +13       SET (SDCANF,SDSCHEDF)=0

 +14       SET SDREC=$$GETIEN("RECEIVED")

 +15       IF SDREC=""

               DO ERR1^SDECERR(-1,"REQUEST ACTION TYPES file does not have an entry of RECEIVED.",.SDECI,SDECY)

               QUIT 

 +16       SET SDSCHED=$$GETIEN("SCHEDULED")

 +17       IF SDSCHED=""

               DO ERR1^SDECERR(-1,"REQUEST ACTION TYPES file does not have an entry of SCHEDULED.",.SDECI,SDECY)

               QUIT 

 +18       SET SDSTAT=$$GETIEN("STATUS CHANGE")

 +19       SET SDCAN=$$GETIEN("CANCELLED")

 +20       SET SDDONE=$$GETIEN("COMPLETE/UPDATE")

 +21       SET SDCDC=$$GETIEN("DISCONTINUED")

 +22      ;validate SDBEG (optional)

 +23       SET SDBEG=$GET(SDBEG)

 +24       IF $GET(SDBEG)'=""

               SET %DT=""

               SET X=$PIECE($GET(SDBEG),"@",1)

               DO ^%DT

               SET SDBEG=Y

               IF Y=-1

                   SET SDBEG=$$FMADD^XLFDT($PIECE($$NOW^XLFDT,".",1),-1825)

 +25       IF $GET(SDBEG)=""

               SET SDBEG=$$FMADD^XLFDT($PIECE($$NOW^XLFDT,".",1),-1825)

 +26      ;validate SDEND (optional)

 +27       SET SDEND=$GET(SDEND)

 +28       IF SDEND'=""

               SET %DT=""

               SET X=$PIECE($GET(SDEND),"@",1)

               DO ^%DT

               SET SDEND=Y

               IF Y=-1

                   SET SDEND=$$FMADD^XLFDT($PIECE($$NOW^XLFDT,".",1),-90)

 +29       IF SDEND=""

               SET SDEND=$$FMADD^XLFDT($PIECE($$NOW^XLFDT,".",1),-90)

 +30      ;validate SDGMR (optional)

 +31       SET SDGMR=$GET(SDGMR)

 +32      ;ICR 4837

           IF SDGMR'=""

               IF '$DATA(^GMR(123,+SDGMR,0))

                   DO ERR1^SDECERR(-1,"Invalid Request/Consultation ID.",.SDECI,SDECY)

                   QUIT 

 +33       IF SDGMR'=""

               SET SDNOCHK=1

               DO REQGET1

               GOTO REQX

 +34      ;validate MAXREC (optional)

 +35       SET MAXREC=+$GET(MAXREC)

 +36       IF 'MAXREC

               SET MAXREC=9999999

 +37      ;validate LASTSUB (optional)

 +38       SET LASTSUB=$GET(LASTSUB)

 +39       SET SDCNT=0

 +40       SET SDJ=$SELECT($PIECE(LASTSUB,"|",1)'="":$PIECE(LASTSUB,"|",1),1:(SDBEG-1)_".2359")

 +41       NEW SDJ,SDJ1,SD90,SVC

 +42       NEW %DT,X,Y

 +43       NEW DRQ,OSACT,OSPEND,SDGMR,STAT

 +44       SET OSACT=$ORDER(^ORD(100.01,"B","ACTIVE",0))

 +45       SET OSPEND=$ORDER(^ORD(100.01,"B","PENDING",0))

 +46       SET SDECI=$GET(SDECI,0)

 +47       SET SVC=$SELECT($PIECE(LASTSUB,"|",1)'="":$PIECE(LASTSUB,"|",1)-1,1:0)

 +48       FOR 

               SET SVC=$ORDER(^GMR(123,"AE",SVC))

               if SVC=""

                   QUIT 

               Begin DoDot:1

 +49               FOR STAT=OSACT,OSPEND

                       Begin DoDot:2

 +50                       if STAT=""

                               QUIT 

 +51                       if ($PIECE(LASTSUB,"|",2)'="")&($PIECE(LASTSUB,"|",2)'=STAT)

                               QUIT 

 +52                       SET DRQ=$SELECT($PIECE(LASTSUB,"|",3)'="":$PIECE(LASTSUB,"|",3)-.0001,1:SDBEG-1)

 +53                       FOR 

                               SET DRQ=$ORDER(^GMR(123,"AE",SVC,STAT,DRQ))

                               if DRQ=""

                                   QUIT 

                               if $PIECE(DRQ,".",1)>SDEND

                                   QUIT 

                               Begin DoDot:3

 +54                               SET SDGMR=$SELECT($PIECE(LASTSUB,"|",4)'="":$PIECE(LASTSUB,"|",4),1:0)

 +55                               SET LASTSUB=""

 +56                               FOR 

                                       SET SDGMR=$ORDER(^GMR(123,"AE",SVC,STAT,DRQ,SDGMR))

                                       if SDGMR=""

                                           QUIT 

                                       DO REQGET1

                                       IF SDECI>(MAXREC-1)

                                           SET SDSUB=SVC_"|"_STAT_"|"_DRQ_"|"_SDGMR

                                           QUIT 

                               End DoDot:3

                               if SDECI>(MAXREC-1)

                                   QUIT 

                       End DoDot:2

                       if SDECI>(MAXREC-1)

                           QUIT 

               End DoDot:1

               if SDECI>(MAXREC-1)

                   QUIT 

REQX      ;

 +1        SET SDTMP=@SDECY@(SDECI)

           SET SDTMP=$PIECE(SDTMP,$CHAR(30),1)

 +2        if $GET(SDSUB)'=""

               SET $PIECE(SDTMP,U,40)=SDSUB

 +3        SET @SDECY@(SDECI)=SDTMP_$CHAR(30,31)

 +4        QUIT 

HDR       ;Get the header information

 +1       ;              1                 2           3         4

 +2        SET SDTMP="T00020CONSULTIEN^T00020ORIGDT^T00020DFN^T00030NAME"

 +3       ;                     5                6             7              8                     9

 +4        SET SDTMP=SDTMP_"^T00030TO_SERVICE^T00010CLINIEN^T00030CLINNAME^T00030DATE_OF_REQUEST^T00030PRIO"

 +5       ;                     10            11             12            13

 +6        SET SDTMP=SDTMP_"^T00030USERIEN^T00030USERNAME^T00030PROVIEN^T00030PROVNAME"

 +7       ;                     14                 15                        16         17

 +8        SET SDTMP=SDTMP_"^T00030REQUEST_TYPE^T00030SERVICE_RENDERED_AS^T00100COMM^T00500REQ_PROC_ACT"

 +9       ;                     18        19        20        21           22            23

 +10       SET SDTMP=SDTMP_"^T00030HRN^T00030DOB^T00030SSN^T00030GENDER^T00030INSTIEN^T00030INSTNAME"

 +11      ;                     24           25            26             27            28

 +12       SET SDTMP=SDTMP_"^T00030PRIGRP^T00030ELIGIEN^T00030ELIGNAME^T00030SVCCONN^T00030SVCCONNP"

 +13      ;                     29            30             31             32             33

 +14       SET SDTMP=SDTMP_"^T00030TYPEIEN^T00030TYPENAME^T00030PADDRES1^T00030PADDRES2^T00030PADDRES3"

 +15      ;                     34          35           36             37          38      39             40

 +16       SET SDTMP=SDTMP_"^T00030PCITY^T00030PSTATE^T00030PCOUNTRY^T00030PZIP4^T00030GAF^T00100SENSITIVE^T00030LASTSUB"

 +17      ;                     41         42            43            44          45           46         47

 +18       SET SDTMP=SDTMP_"^T00100STOP^T00030PTPHONE^T00030URGENCY^T00030PRACE^T00030PRACEN^T00030PETH^T00030PETHN"

 +19      ;                     48            49

 +20       SET SDTMP=SDTMP_"^T00030PRHBLOC^T00030EARLIEST"

 +21      ;55

           SET SDTMP=SDTMP_"^T00030BADADD^T00030OPHONE^T00030NOK^T00030KNAME^T00030KREL^T00030KPHONE"

 +22      ;61

           SET SDTMP=SDTMP_"^T00030KSTREET^T00030KSTREET2^T00030KSTREET3^T00030KCITY^T00030KSTATE^T00030KZIP"

 +23      ;65

           SET SDTMP=SDTMP_"^T00030NOK2^T00030K2NAME^T00030K2REL^T00030K2PHONE"

 +24      ;72

           SET SDTMP=SDTMP_"^T00030K2STREET^T00030K2STREET2^T00030K2STREET3^T00030K2CITY^T00030K2STATE^T00030K2ZIP^T00030PCOUNTY"

 +25      ;74

           SET SDTMP=SDTMP_"^T00030PMARITAL^T00030PRELIGION"

 +26      ;82

           SET SDTMP=SDTMP_"^T00030PTACTIVE^T00030PTADDRESS1^T00030PTADDRESS2PTADDRESS3^T00030^T00030PTCITY^T00030PTSTATE^T00030PTZIP^T00030PTZIP+4"

 +27      ;90

           SET SDTMP=SDTMP_"^T00030PTCOUNTRY^T00030PTCOUNTY^T00030PTPHONE^T00030PTSTART^T00030PTEND^T00030PCELL^T00030PPAGER^T00030PEMAIL"

 +28      ;97

           SET SDTMP=SDTMP_"^T00030PF_FFF^T00030PF_VCD^T00030PFNATIONAL^T00030PFLOCAL^T00030SUBGRP^T00030CAT8G^T01000SIMILAR"

 +29      ;99  added call phone & letter  *745  5/14/2020

           SET SDTMP=SDTMP_"^T00030CPHONE^T00030CLET"

 +30      ;*756

           SET SDTMP=SDTMP_"^T00030COVID_PRIORITY"

 +31      ;101^102^103 *813

           SET SDTMP=SDTMP_"^T00030CEMAIL^T00030CTEXT^T00030CSEC"

 +32       SET @SDECY@(SDECI)=SDTMP_$CHAR(30)

 +33       QUIT 

GETONE(SDECY,SDGMR) ;Get one specific consult

 +1       ;              1                 2           3         4

 +2        NEW PADDRES1,PADDRES2,PADDRES3,PCITY,PSTATE,PCOUNTRY,PZIP4

 +3        NEW SDECI,SDI,SDJ,SDREASON,SDREC,SDRECL,SDRPA,SDRPA0,SDTMP,SDWP,X,Y,%DT

 +4        NEW SDCNT,SDCAN,SDCDC,SDCANF,SDCSTOP,SDSCHED,SDSCHEDF,SDSENS,SDSTAT,SDSTATF,SDDONE

 +5        NEW ELIGIEN,ELIGNAME,GAF,PRIGRP,SVCCONN,SVCCONNP,TYPEIEN,TYPENAME

 +6        NEW SDDEMO,SDSUB,SDCON

 +7        NEW DOB,GENDER,HRN,INSTIEN,INSTNAME,NAME,SSN,SVVCCONN

 +8        NEW PRACE,PRACEN,PETH,PETHN,CLIEN,CLNAME

 +9        SET SDSUB=""

 +10       SET SDECI=0

 +11       KILL ^TMP("SDEC",$JOB)

 +12       SET SDECY="^TMP(""SDEC"","_$JOB_")"

 +13       DO HDR

 +14       SET (SDCANF,SDSCHEDF)=0

 +15       SET SDREC=$$GETIEN("RECEIVED")

 +16       IF SDREC=""

               DO ERR1^SDECERR(-1,"REQUEST ACTION TYPES file does not have an entry of RECEIVED.",.SDECI,SDECY)

               QUIT 

 +17       SET SDSCHED=$$GETIEN("SCHEDULED")

 +18       IF SDSCHED=""

               DO ERR1^SDECERR(-1,"REQUEST ACTION TYPES file does not have an entry of SCHEDULED.",.SDECI,SDECY)

               QUIT 

 +19       SET SDSTAT=$$GETIEN("STATUS CHANGE")

 +20       SET SDCAN=$$GETIEN("CANCELLED")

 +21       SET SDDONE=$$GETIEN("COMPLETE/UPDATE")

 +22       SET SDCDC=$$GETIEN("DISCONTINUED")

 +23       DO REQGET1