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

SDEC51A.m

Go to the documentation of this file.
  1. SDEC51A ;ALB/SAT - VISTA SCHEDULING RPCS ;MAR 15, 2017
  1. ;;5.3;Scheduling;**658**;Aug 13, 1993;Build 23
  1. ;
  1. ;Reference is made to ICR's #4837 and #6185
  1. Q
  1. ;
  1. FINDTXT(SDGMR,SDRPA,SDTXT) ;find text in word processing field
  1. ;INPUT:
  1. ; SDGMR - Pointer to REQUEST/CONSULTATION file
  1. ; SDRPA - Pointer to REQUEST PROCESSING ACTIVITY in REQUEST/CONSULTATION file
  1. ;RETURN:
  1. ; 1=Text Fount; 0=Not Found
  1. N SDI,SDJ,SDLINE,SDMSG,SDPREV,SDRET,SDTHIS,SDWP,X ;alb/sat 651 add SDLINE
  1. S (SDTHIS,SDPREV)=""
  1. S SDRET=0
  1. S SDTXT=$G(SDTXT) S:SDTXT'="" SDTXT=$$UP^XLFSTR(SDTXT) ;alb/sat 651
  1. K SDWP S X=$$GET1^DIQ(123.02,SDRPA_","_SDGMR_",",5,"","SDWP","SDMSG") ;ICR 6185
  1. S SDI=0 F S SDI=$O(SDWP(SDI)) Q:SDI="" D Q:SDRET=1
  1. .S SDTHIS=SDWP(SDI)
  1. .;alb/sat 651 begin modification
  1. .;I $$UP^XLFSTR(SDPREV_SDTHIS)[SDTXT S SDRET=1
  1. .S SDLINE=$$UP^XLFSTR(SDPREV_SDTHIS)
  1. .I SDTXT'="" S:SDLINE[SDTXT SDRET=1 Q
  1. .F SDJ=1:1 S SDTXT=$P($T(SDTXT+SDJ),";;",2) Q:SDTXT="" D Q:SDRET=1
  1. ..S:SDLINE[SDTXT SDRET=1
  1. .;alb/sat 651 end modification
  1. .S SDPREV=SDTHIS
  1. Q SDRET
  1. ;
  1. ;alb/sat 651
  1. SDTXT ;
  1. ;;CANCEL
  1. ;;NOSHOW
  1. ;;NO-SHOW
  1. ;;NO SHOW
  1. ;
  1. ;
  1. PRIO(SDGMR) ;
  1. N CNT,F81,FED,PRIO,PRIO1,RET,SDED,SDI ;alb/sat 658 added CNT, F81 and SDI
  1. ;alb/sat 658 start modification - if GMRC*3.0*81 has been installed/loaded at or before the file entry date/time, then always use the Earliest Date (Clinically Indicated Date)
  1. S F81=9999999
  1. S CNT=$$INSTALDT^XPDUTL("GMRC*3.0*81",.RET)
  1. I CNT>0 S F81=$O(RET(0))
  1. S SDED=$P($$GET1^DIQ(123,SDGMR_",",17,"I"),".",1) ;earliest date ;ICR 6185 ;alb/sat 658 moved this and next line up from under 'S PRIO=""'
  1. S FED=$P($$GET1^DIQ(123,SDGMR_",",.01,"I"),".",1) ;file entry date ;ICR 4837
  1. S PRIO=""
  1. I F81'>FED S PRIO=SDED G PRIOX
  1. ;alb/sat 658 end modification
  1. S PRIO1=$$GET1^DIQ(123,SDGMR_",",5) ;urgency text ;ICR 4837
  1. I SDED="" S PRIO=PRIO1 ;2.6.17.2 - use URGENCY text if EARLIEST DATE is null
  1. I (PRIO=""),(FED="")!(SDED'=FED) S PRIO=SDED ;2.6.17.1 - use EARLIEST DATE if not = FILE ENTRY DATE
  1. I (PRIO=""),((PRIO1["STAT")!(PRIO1["NEXT AVAILABLE")!(PRIO1["EMERGENCY")!(PRIO1["TODAY")) S PRIO=SDED ;2.6.17.3
  1. S:PRIO="" PRIO=PRIO1 ;2.6.17.3
  1. PRIOX Q PRIO ;alb/sat 658 added PRIOX tag
  1. ;
  1. SDCHED(DFN,SDACTDT,SDTSVC) ;look for appointment with stop code for REQUEST SERVICES
  1. ;INPUT:
  1. ; DFN - patient ID pointer to PATIENT file
  1. ; SDACTDT - actual activity date in FM format
  1. ; SDTSVC - request services ID pointer to REQUEST SERVICES file 123.5
  1. ;RETURN:
  1. ; 0 = no appointment found with matching stop code
  1. ; 1 = appointment found with matching stop code
  1. ;Q 1 ;do not check for match for now
  1. N SDCL,SDI,SDRET,SDSTP,SDSTPL
  1. S SDRET=0
  1. S SDTSVC=$G(SDTSVC)
  1. Q:SDTSVC="" 0
  1. S SDACTDT=$P($G(SDACTDT),".",1)
  1. I SDACTDT'?7N S SDACTDT=1410102 ;alb/sat 658 use valid FM range instead of 1000101
  1. S SDI=0 F S SDI=$O(^GMR(123.5,SDTSVC,688,SDI)) Q:SDI'>0 D Q:SDRET=1
  1. .S SDSTPL(+$P($G(^GMR(123.5,SDTSVC,688,SDI,0)),U,1))="" ;ICR 4557
  1. S SDI=$$FMADD^XLFDT(SDACTDT,-2) F S SDI=$O(^DPT(DFN,"S",SDI)) Q:SDI'>0 D
  1. .S SDCL=$$GET1^DIQ(2.98,SDI_","_DFN_",",.01,"I")
  1. .S SDSTP=$$GET1^DIQ(44,SDCL_",",8,"I")
  1. .I $$GET1^DIQ(2.98,SDI_","_DFN_",",15,"I")="",$D(SDSTPL(+SDSTP)) S SDRET=1 ;alb/sat 651
  1. Q SDRET