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

SDEC665.m

Go to the documentation of this file. 
  1. SDEC665 ;ALB/SAT/JSM - VISTA SCHEDULING PRE/POST ;JUN 21, 2017
  1.  ;;5.3;Scheduling;**665**;Aug 13, 1993;Build 14
  1.  ;
  1.  Q
  1.  ;
  1. PRE ;
  1.  Q
  1.  ;
  1. POST ;alb/sat 665
  1.  D NOTE
  1.  Q
  1.  ;
  1. NOTE  ;sync OTHER in HOSPITAL LOCATION appointment record and NOTE in SDEC APPOINTMENT
  1.  ;per Irene Smith, Debbie Malkovich 2/8/2017
  1.  ; If NOTE is empty AND OTHER is defined, OTHER data will be set to NOTE.
  1.  ; If NOTE is defined AND OTHER is defined, OTHER data will be set to NOTE - NOTE data is replaced by OTHER data. (VistA wins!)
  1.  ; If NOTE is defined AND OTHER is empty, NOTE data will be set to OTHER
  1.  N Y
  1.  S Y=$$NOW^XLFDT,Y=$$FMTE^XLFDT(Y)
  1.  W !!,"Syncing OTHER in clinic appointments with NOTE in SDEC APPOINTMENTs ..."
  1.  W !,Y
  1.  N ZTDESC,ZTDTH,ZTIO,ZTRTN
  1.  S ZTRTN="N2^SDEC665"
  1.  S ZTIO=""
  1.  S ZTDTH=$$FMADD^XLFDT($$NOW^XLFDT,,,1)
  1.  S ZTDESC="SD*5.3*665 NOTE UPDATE REPORT DATA"
  1.  D ^%ZTLOAD
  1.  Q
  1. N2  ;called by background job
  1.  ;GET conflicts
  1.  N AIEN,AIEN2,ANOD,CNOT,ARR,CNT,LCNT,LINE,SC,SCN,SDR,SDT,SDTMP,SDX,SID,SNOD,SNOT,SSC,X,XMSUB,XMTEXT,XMY,SDECSDT
  1.  K ^XTMP("VSGUI_OI")
  1.  S ^XTMP("VSGUI_OI",0)=$$FMADD^XLFDT(DT,7)_U_$$DT^XLFDT S $P(LINE,"=",78)="="
  1.  S (CNT,LCNT)=0
  1.  S SDX="^XTMP(""SDEC665M"")"
  1.  K @SDX
  1.  S @SDX@(0)=$$FMADD^XLFDT(DT,7)_U_$$DT^XLFDT
  1.  S SDECSDT=$O(^SDEC(409.84,"B",0))  ;alb/jsm set very first starttime of SDEC APPOINTMENTS
  1.  D BLD("CONFLICTS:"),BLD("=========")
  1.  D BLD(LINE)
  1.  S SCN="" F  S SCN=$O(^SC("AG","C",SCN)) Q:SCN=""  D
  1.  .S SC=0 F  S SC=$O(^SC("AG","C",SCN,SC)) Q:SC=""  D
  1.  ..S SDT=$P(SDECSDT,".",1) F  S SDT=$O(^SC(SC,"S",SDT)) Q:SDT'>0  D  ;alb/jsm reset SDT to the starttime from SDEC APPOINTMENTS
  1.  ...S AIEN=0 F  S AIEN=$O(^SC(SC,"S",SDT,1,AIEN)) Q:AIEN'>0  D
  1.  ....S ANOD=$G(^SC(SC,"S",SDT,1,AIEN,0))
  1.  ....S CNOT=$P(ANOD,U,4)
  1.  ....S AIEN2=$$FIND^SDAM2($P(ANOD,U,1),SDT,SC)  ;665
  1.  ....I AIEN2=AIEN D  ;665
  1.  .....S SID=0 F  S SID=$O(^SDEC(409.84,"B",SDT,SID)) Q:SID=""  D
  1.  ......S SNOD=$G(^SDEC(409.84,SID,0))
  1.  ......S SDR=$P(SNOD,U,7),SSC=$$GET1^DIQ(409.831,SDR_",",.04,"I")
  1.  ......I $P(SNOD,U,5)=$P(ANOD,U,1),SC=SSC D
  1.  .......K ARR
  1.  .......S SNOT=""
  1.  .......S X=$$GET1^DIQ(409.84,SID_",",1,,"ARR")
  1.  .......S SNOT=$$WPSTR^SDECUTL(.ARR)
  1.  .......S SNOT=$E(SNOT,1,150)
  1.  .......I SNOT["^" D STRIP K ARR S X=$$GET1^DIQ(409.84,SID_",",1,,"ARR") S SNOT=$$WPSTR^SDECUTL(.ARR) S SNOT=$E(SNOT,1,150)
  1.  .......I CNOT'=SNOT D
  1.  ........S CNT=CNT+1,(XSTR,^XTMP("VSGUI_OI","DIFF",SCN,CNT))=SDT_U_SC_U_SCN_U_AIEN_U_$P(SNOD,U,5)_U_CNOT_U_SID_U_SNOT
  1.  ........S SDTMP=$$GET1^DIQ(2,+$P(XSTR,U,5),.01)_" ("_$P(XSTR,U,5)_")"
  1.  ........D BLD(SDTMP)
  1.  ........S SDTMP="CLINIC: "_$E("("_$P(XSTR,U,2)_") "_$P(XSTR,U,3),1,39),SDTMP=SDTMP_$$FILL^SDECU(49-$L(SDTMP))_"APPT TIME: "_$$FMTE^XLFDT($P(XSTR,U,1))
  1.  ........D BLD(SDTMP)
  1.  ........S SDTMP="OTHER:"
  1.  ........D BLD(SDTMP)
  1.  ........D BLD($P(XSTR,U,6)),BLD("")
  1.  ........S SDTMP="NOTE ("_$P(XSTR,U,7)_"):"
  1.  ........D BLD(SDTMP)
  1.  ........D BLD($P(XSTR,U,8)),BLD(LINE)
  1.  ;FIX conflicts
  1.  K ANOD,CNOT,CNT,IENS,LINE,SCN,SNOT,X,XSTR
  1.  S $P(LINE,"=",78)="="
  1.  D BLD(""),BLD(""),BLD(""),BLD("RESOLUTIONS:"),BLD("===========")
  1.  D BLD(LINE)
  1.  S SCN="" F  S SCN=$O(^XTMP("VSGUI_OI","DIFF",SCN)) Q:SCN=""  D
  1.  .S CNT=0 F  S CNT=$O(^XTMP("VSGUI_OI","DIFF",SCN,CNT)) Q:CNT=""  D
  1.  ..K ARR,FDA
  1.  ..S XSTR=$G(^XTMP("VSGUI_OI","DIFF",SCN,CNT))
  1.  ..S CNOT=$P(XSTR,U,6)
  1.  ..S SNOT=$P(XSTR,U,8)
  1.  ..S IENS=$P(XSTR,U,4)_","_$P(XSTR,U,1)_","_$P(XSTR,U,2)_","
  1.  ..D:(CNOT="")&(SNOT'="") WP^DIE(409.84,$P(XSTR,U,7)_",",1,"","@")   ;FDA(44.003,IENS,3)=SNOT
  1.  ..D:(CNOT'="")&(SNOT="") WP^SDECUTL(.ARR,CNOT)
  1.  ..D:(CNOT'="")&(SNOT'="")&(CNOT'=SNOT) WP^SDECUTL(.ARR,CNOT)
  1.  ..;D:$D(FDA) UPDATE^DIE("","FDA")
  1.  ..D:$D(ARR) WP^DIE(409.84,$P(XSTR,U,7)_",",1,"","ARR")
  1.  ..S ANOD=$G(^SC($P(XSTR,U,2),"S",$P(XSTR,U,1),1,$P(XSTR,U,4),0))
  1.  ..S CNOT=$P(ANOD,U,4)
  1.  ..K ARR
  1.  ..S X=$$GET1^DIQ(409.84,$P(XSTR,U,7)_",",1,,"ARR")
  1.  ..S SNOT=$$WPSTR^SDECUTL(.ARR)
  1.  ..S SNOT=$E(SNOT,1,150)
  1.  ..S SDTMP=$$GET1^DIQ(2,+$P(XSTR,U,5),.01)_" ("_$P(XSTR,U,5)_")"
  1.  ..D BLD(SDTMP)
  1.  ..S SDTMP="CLINIC: "_$E("("_$P(XSTR,U,2)_") "_$P(XSTR,U,3),1,39),SDTMP=SDTMP_$$FILL^SDECU(49-$L(SDTMP))_"APPT TIME: "_$$FMTE^XLFDT($P(XSTR,U,1))
  1.  ..D BLD(SDTMP)
  1.  ..S SDTMP="OTHER:"
  1.  ..D BLD(SDTMP)
  1.  ..D BLD(CNOT)
  1.  ..D BLD("")
  1.  ..S SDTMP="NOTE ("_$P(XSTR,U,7)_"):"
  1.  ..D BLD(SDTMP)
  1.  ..D BLD(SNOT)
  1.  ..D BLD(LINE)
  1.  ;SEND message
  1.  S XMY(DUZ)="",XMSUB="SD*5.3*665 NOTE UPDATE REPORT DATA for "_$$FMTE^XLFDT($$NOW^XLFDT)
  1.  S XMTEXT=$P(SDX,")")_","
  1.  D ^XMD
  1.  Q
  1.  ;
  1. BLD(TXT)  ;build output text for email
  1.  S LCNT=LCNT+1
  1.  S @SDX@(LCNT)=TXT
  1.  Q
  1. STRIP ;
  1.  N FDA
  1.  Q:SNOT'["^"
  1.  S SNOT=$TR(SNOT,"^"," ")
  1.  D WP^SDECUTL(.ARR,SNOT)
  1.  D WP^DIE(409.84,SID_",",1,"","ARR")
  1.  Q