SDEC665 ;ALB/SAT/JSM - VISTA SCHEDULING PRE/POST ;JUN 21, 2017
;;5.3;Scheduling;**665**;Aug 13, 1993;Build 14
;
Q
;
PRE ;
Q
;
POST ;alb/sat 665
D NOTE
Q
;
NOTE ;sync OTHER in HOSPITAL LOCATION appointment record and NOTE in SDEC APPOINTMENT
;per Irene Smith, Debbie Malkovich 2/8/2017
; If NOTE is empty AND OTHER is defined, OTHER data will be set to NOTE.
; If NOTE is defined AND OTHER is defined, OTHER data will be set to NOTE - NOTE data is replaced by OTHER data. (VistA wins!)
; If NOTE is defined AND OTHER is empty, NOTE data will be set to OTHER
N Y
S Y=$$NOW^XLFDT,Y=$$FMTE^XLFDT(Y)
W !!,"Syncing OTHER in clinic appointments with NOTE in SDEC APPOINTMENTs ..."
W !,Y
N ZTDESC,ZTDTH,ZTIO,ZTRTN
S ZTRTN="N2^SDEC665"
S ZTIO=""
S ZTDTH=$$FMADD^XLFDT($$NOW^XLFDT,,,1)
S ZTDESC="SD*5.3*665 NOTE UPDATE REPORT DATA"
D ^%ZTLOAD
Q
N2 ;called by background job
;GET conflicts
N AIEN,AIEN2,ANOD,CNOT,ARR,CNT,LCNT,LINE,SC,SCN,SDR,SDT,SDTMP,SDX,SID,SNOD,SNOT,SSC,X,XMSUB,XMTEXT,XMY,SDECSDT
K ^XTMP("VSGUI_OI")
S ^XTMP("VSGUI_OI",0)=$$FMADD^XLFDT(DT,7)_U_$$DT^XLFDT S $P(LINE,"=",78)="="
S (CNT,LCNT)=0
S SDX="^XTMP(""SDEC665M"")"
K @SDX
S @SDX@(0)=$$FMADD^XLFDT(DT,7)_U_$$DT^XLFDT
S SDECSDT=$O(^SDEC(409.84,"B",0)) ;alb/jsm set very first starttime of SDEC APPOINTMENTS
D BLD("CONFLICTS:"),BLD("=========")
D BLD(LINE)
S SCN="" F S SCN=$O(^SC("AG","C",SCN)) Q:SCN="" D
.S SC=0 F S SC=$O(^SC("AG","C",SCN,SC)) Q:SC="" D
..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
...S AIEN=0 F S AIEN=$O(^SC(SC,"S",SDT,1,AIEN)) Q:AIEN'>0 D
....S ANOD=$G(^SC(SC,"S",SDT,1,AIEN,0))
....S CNOT=$P(ANOD,U,4)
....S AIEN2=$$FIND^SDAM2($P(ANOD,U,1),SDT,SC) ;665
....I AIEN2=AIEN D ;665
.....S SID=0 F S SID=$O(^SDEC(409.84,"B",SDT,SID)) Q:SID="" D
......S SNOD=$G(^SDEC(409.84,SID,0))
......S SDR=$P(SNOD,U,7),SSC=$$GET1^DIQ(409.831,SDR_",",.04,"I")
......I $P(SNOD,U,5)=$P(ANOD,U,1),SC=SSC D
.......K ARR
.......S SNOT=""
.......S X=$$GET1^DIQ(409.84,SID_",",1,,"ARR")
.......S SNOT=$$WPSTR^SDECUTL(.ARR)
.......S SNOT=$E(SNOT,1,150)
.......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)
.......I CNOT'=SNOT D
........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
........S SDTMP=$$GET1^DIQ(2,+$P(XSTR,U,5),.01)_" ("_$P(XSTR,U,5)_")"
........D BLD(SDTMP)
........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))
........D BLD(SDTMP)
........S SDTMP="OTHER:"
........D BLD(SDTMP)
........D BLD($P(XSTR,U,6)),BLD("")
........S SDTMP="NOTE ("_$P(XSTR,U,7)_"):"
........D BLD(SDTMP)
........D BLD($P(XSTR,U,8)),BLD(LINE)
;FIX conflicts
K ANOD,CNOT,CNT,IENS,LINE,SCN,SNOT,X,XSTR
S $P(LINE,"=",78)="="
D BLD(""),BLD(""),BLD(""),BLD("RESOLUTIONS:"),BLD("===========")
D BLD(LINE)
S SCN="" F S SCN=$O(^XTMP("VSGUI_OI","DIFF",SCN)) Q:SCN="" D
.S CNT=0 F S CNT=$O(^XTMP("VSGUI_OI","DIFF",SCN,CNT)) Q:CNT="" D
..K ARR,FDA
..S XSTR=$G(^XTMP("VSGUI_OI","DIFF",SCN,CNT))
..S CNOT=$P(XSTR,U,6)
..S SNOT=$P(XSTR,U,8)
..S IENS=$P(XSTR,U,4)_","_$P(XSTR,U,1)_","_$P(XSTR,U,2)_","
..D:(CNOT="")&(SNOT'="") WP^DIE(409.84,$P(XSTR,U,7)_",",1,"","@") ;FDA(44.003,IENS,3)=SNOT
..D:(CNOT'="")&(SNOT="") WP^SDECUTL(.ARR,CNOT)
..D:(CNOT'="")&(SNOT'="")&(CNOT'=SNOT) WP^SDECUTL(.ARR,CNOT)
..;D:$D(FDA) UPDATE^DIE("","FDA")
..D:$D(ARR) WP^DIE(409.84,$P(XSTR,U,7)_",",1,"","ARR")
..S ANOD=$G(^SC($P(XSTR,U,2),"S",$P(XSTR,U,1),1,$P(XSTR,U,4),0))
..S CNOT=$P(ANOD,U,4)
..K ARR
..S X=$$GET1^DIQ(409.84,$P(XSTR,U,7)_",",1,,"ARR")
..S SNOT=$$WPSTR^SDECUTL(.ARR)
..S SNOT=$E(SNOT,1,150)
..S SDTMP=$$GET1^DIQ(2,+$P(XSTR,U,5),.01)_" ("_$P(XSTR,U,5)_")"
..D BLD(SDTMP)
..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))
..D BLD(SDTMP)
..S SDTMP="OTHER:"
..D BLD(SDTMP)
..D BLD(CNOT)
..D BLD("")
..S SDTMP="NOTE ("_$P(XSTR,U,7)_"):"
..D BLD(SDTMP)
..D BLD(SNOT)
..D BLD(LINE)
;SEND message
S XMY(DUZ)="",XMSUB="SD*5.3*665 NOTE UPDATE REPORT DATA for "_$$FMTE^XLFDT($$NOW^XLFDT)
S XMTEXT=$P(SDX,")")_","
D ^XMD
Q
;
BLD(TXT) ;build output text for email
S LCNT=LCNT+1
S @SDX@(LCNT)=TXT
Q
STRIP ;
N FDA
Q:SNOT'["^"
S SNOT=$TR(SNOT,"^"," ")
D WP^SDECUTL(.ARR,SNOT)
D WP^DIE(409.84,SID_",",1,"","ARR")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDEC665 4695 printed Apr 09, 2024@21:40:20 Page 2
SDEC665 ;ALB/SAT/JSM - VISTA SCHEDULING PRE/POST ;JUN 21, 2017
+1 ;;5.3;Scheduling;**665**;Aug 13, 1993;Build 14
+2 ;
+3 QUIT
+4 ;
PRE ;
+1 QUIT
+2 ;
POST ;alb/sat 665
+1 DO NOTE
+2 QUIT
+3 ;
NOTE ;sync OTHER in HOSPITAL LOCATION appointment record and NOTE in SDEC APPOINTMENT
+1 ;per Irene Smith, Debbie Malkovich 2/8/2017
+2 ; If NOTE is empty AND OTHER is defined, OTHER data will be set to NOTE.
+3 ; If NOTE is defined AND OTHER is defined, OTHER data will be set to NOTE - NOTE data is replaced by OTHER data. (VistA wins!)
+4 ; If NOTE is defined AND OTHER is empty, NOTE data will be set to OTHER
+5 NEW Y
+6 SET Y=$$NOW^XLFDT
SET Y=$$FMTE^XLFDT(Y)
+7 WRITE !!,"Syncing OTHER in clinic appointments with NOTE in SDEC APPOINTMENTs ..."
+8 WRITE !,Y
+9 NEW ZTDESC,ZTDTH,ZTIO,ZTRTN
+10 SET ZTRTN="N2^SDEC665"
+11 SET ZTIO=""
+12 SET ZTDTH=$$FMADD^XLFDT($$NOW^XLFDT,,,1)
+13 SET ZTDESC="SD*5.3*665 NOTE UPDATE REPORT DATA"
+14 DO ^%ZTLOAD
+15 QUIT
N2 ;called by background job
+1 ;GET conflicts
+2 NEW AIEN,AIEN2,ANOD,CNOT,ARR,CNT,LCNT,LINE,SC,SCN,SDR,SDT,SDTMP,SDX,SID,SNOD,SNOT,SSC,X,XMSUB,XMTEXT,XMY,SDECSDT
+3 KILL ^XTMP("VSGUI_OI")
+4 SET ^XTMP("VSGUI_OI",0)=$$FMADD^XLFDT(DT,7)_U_$$DT^XLFDT
SET $PIECE(LINE,"=",78)="="
+5 SET (CNT,LCNT)=0
+6 SET SDX="^XTMP(""SDEC665M"")"
+7 KILL @SDX
+8 SET @SDX@(0)=$$FMADD^XLFDT(DT,7)_U_$$DT^XLFDT
+9 ;alb/jsm set very first starttime of SDEC APPOINTMENTS
SET SDECSDT=$ORDER(^SDEC(409.84,"B",0))
+10 DO BLD("CONFLICTS:")
DO BLD("=========")
+11 DO BLD(LINE)
+12 SET SCN=""
FOR
SET SCN=$ORDER(^SC("AG","C",SCN))
if SCN=""
QUIT
Begin DoDot:1
+13 SET SC=0
FOR
SET SC=$ORDER(^SC("AG","C",SCN,SC))
if SC=""
QUIT
Begin DoDot:2
+14 ;alb/jsm reset SDT to the starttime from SDEC APPOINTMENTS
SET SDT=$PIECE(SDECSDT,".",1)
FOR
SET SDT=$ORDER(^SC(SC,"S",SDT))
if SDT'>0
QUIT
Begin DoDot:3
+15 SET AIEN=0
FOR
SET AIEN=$ORDER(^SC(SC,"S",SDT,1,AIEN))
if AIEN'>0
QUIT
Begin DoDot:4
+16 SET ANOD=$GET(^SC(SC,"S",SDT,1,AIEN,0))
+17 SET CNOT=$PIECE(ANOD,U,4)
+18 ;665
SET AIEN2=$$FIND^SDAM2($PIECE(ANOD,U,1),SDT,SC)
+19 ;665
IF AIEN2=AIEN
Begin DoDot:5
+20 SET SID=0
FOR
SET SID=$ORDER(^SDEC(409.84,"B",SDT,SID))
if SID=""
QUIT
Begin DoDot:6
+21 SET SNOD=$GET(^SDEC(409.84,SID,0))
+22 SET SDR=$PIECE(SNOD,U,7)
SET SSC=$$GET1^DIQ(409.831,SDR_",",.04,"I")
+23 IF $PIECE(SNOD,U,5)=$PIECE(ANOD,U,1)
IF SC=SSC
Begin DoDot:7
+24 KILL ARR
+25 SET SNOT=""
+26 SET X=$$GET1^DIQ(409.84,SID_",",1,,"ARR")
+27 SET SNOT=$$WPSTR^SDECUTL(.ARR)
+28 SET SNOT=$EXTRACT(SNOT,1,150)
+29 IF SNOT["^"
DO STRIP
KILL ARR
SET X=$$GET1^DIQ(409.84,SID_",",1,,"ARR")
SET SNOT=$$WPSTR^SDECUTL(.ARR)
SET SNOT=$EXTRACT(SNOT,1,150)
+30 IF CNOT'=SNOT
Begin DoDot:8
+31 SET CNT=CNT+1
SET (XSTR,^XTMP("VSGUI_OI","DIFF",SCN,CNT))=SDT_U_SC_U_SCN_U_AIEN_U_$PIECE(SNOD,U,5)_U_CNOT_U_SID_U_SNOT
+32 SET SDTMP=$$GET1^DIQ(2,+$PIECE(XSTR,U,5),.01)_" ("_$PIECE(XSTR,U,5)_")"
+33 DO BLD(SDTMP)
+34 SET SDTMP="CLINIC: "_$EXTRACT("("_$PIECE(XSTR,U,2)_") "_$PIECE(XSTR,U,3),1,39)
SET SDTMP=SDTMP_$$FILL^SDECU(49-$LENGTH(SDTMP))_"APPT TIME: "_$$FMTE^XLFDT($PIECE(XSTR,U,1))
+35 DO BLD(SDTMP)
+36 SET SDTMP="OTHER:"
+37 DO BLD(SDTMP)
+38 DO BLD($PIECE(XSTR,U,6))
DO BLD("")
+39 SET SDTMP="NOTE ("_$PIECE(XSTR,U,7)_"):"
+40 DO BLD(SDTMP)
+41 DO BLD($PIECE(XSTR,U,8))
DO BLD(LINE)
End DoDot:8
End DoDot:7
End DoDot:6
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+42 ;FIX conflicts
+43 KILL ANOD,CNOT,CNT,IENS,LINE,SCN,SNOT,X,XSTR
+44 SET $PIECE(LINE,"=",78)="="
+45 DO BLD("")
DO BLD("")
DO BLD("")
DO BLD("RESOLUTIONS:")
DO BLD("===========")
+46 DO BLD(LINE)
+47 SET SCN=""
FOR
SET SCN=$ORDER(^XTMP("VSGUI_OI","DIFF",SCN))
if SCN=""
QUIT
Begin DoDot:1
+48 SET CNT=0
FOR
SET CNT=$ORDER(^XTMP("VSGUI_OI","DIFF",SCN,CNT))
if CNT=""
QUIT
Begin DoDot:2
+49 KILL ARR,FDA
+50 SET XSTR=$GET(^XTMP("VSGUI_OI","DIFF",SCN,CNT))
+51 SET CNOT=$PIECE(XSTR,U,6)
+52 SET SNOT=$PIECE(XSTR,U,8)
+53 SET IENS=$PIECE(XSTR,U,4)_","_$PIECE(XSTR,U,1)_","_$PIECE(XSTR,U,2)_","
+54 ;FDA(44.003,IENS,3)=SNOT
if (CNOT="")&(SNOT'="")
DO WP^DIE(409.84,$PIECE(XSTR,U,7)_",",1,"","@")
+55 if (CNOT'="")&(SNOT="")
DO WP^SDECUTL(.ARR,CNOT)
+56 if (CNOT'="")&(SNOT'="")&(CNOT'=SNOT)
DO WP^SDECUTL(.ARR,CNOT)
+57 ;D:$D(FDA) UPDATE^DIE("","FDA")
+58 if $DATA(ARR)
DO WP^DIE(409.84,$PIECE(XSTR,U,7)_",",1,"","ARR")
+59 SET ANOD=$GET(^SC($PIECE(XSTR,U,2),"S",$PIECE(XSTR,U,1),1,$PIECE(XSTR,U,4),0))
+60 SET CNOT=$PIECE(ANOD,U,4)
+61 KILL ARR
+62 SET X=$$GET1^DIQ(409.84,$PIECE(XSTR,U,7)_",",1,,"ARR")
+63 SET SNOT=$$WPSTR^SDECUTL(.ARR)
+64 SET SNOT=$EXTRACT(SNOT,1,150)
+65 SET SDTMP=$$GET1^DIQ(2,+$PIECE(XSTR,U,5),.01)_" ("_$PIECE(XSTR,U,5)_")"
+66 DO BLD(SDTMP)
+67 SET SDTMP="CLINIC: "_$EXTRACT("("_$PIECE(XSTR,U,2)_") "_$PIECE(XSTR,U,3),1,39)
SET SDTMP=SDTMP_$$FILL^SDECU(49-$LENGTH(SDTMP))_"APPT TIME: "_$$FMTE^XLFDT($PIECE(XSTR,U,1))
+68 DO BLD(SDTMP)
+69 SET SDTMP="OTHER:"
+70 DO BLD(SDTMP)
+71 DO BLD(CNOT)
+72 DO BLD("")
+73 SET SDTMP="NOTE ("_$PIECE(XSTR,U,7)_"):"
+74 DO BLD(SDTMP)
+75 DO BLD(SNOT)
+76 DO BLD(LINE)
End DoDot:2
End DoDot:1
+77 ;SEND message
+78 SET XMY(DUZ)=""
SET XMSUB="SD*5.3*665 NOTE UPDATE REPORT DATA for "_$$FMTE^XLFDT($$NOW^XLFDT)
+79 SET XMTEXT=$PIECE(SDX,")")_","
+80 DO ^XMD
+81 QUIT
+82 ;
BLD(TXT) ;build output text for email
+1 SET LCNT=LCNT+1
+2 SET @SDX@(LCNT)=TXT
+3 QUIT
STRIP ;
+1 NEW FDA
+2 if SNOT'["^"
QUIT
+3 SET SNOT=$TRANSLATE(SNOT,"^"," ")
+4 DO WP^SDECUTL(.ARR,SNOT)
+5 DO WP^DIE(409.84,SID_",",1,"","ARR")
+6 QUIT