SDEC29 ;ALB/SAT - VISTA SCHEDULING RPCS ;JAN 15, 2016
;;5.3;Scheduling;**627,740**;Aug 13, 1993;Build 12
;
Q
;
COPYAPPT(SDECY,SDECRES,SDEC44,SDECBEG,SDECEND) ;Copy appointments from HOSPITAL LOCATION to SDEC RESOURCE
;COPYAPPT(SDECY,SDECRES,SDEC44,SDECBEG,SDECEND) external parameter tag is in SDEC
;Copy appointments from HOSPITAL LOCATION entry SDEC44 to SDEC RESOURCE entry SDECRES
;Beginning with appointments on day SDECBEG and ending on SDECEND, inclusive
;
;Returns ADO Recordset formatted fields containing count of records copied and error message:
;
;
S SDECY="^TMP(""SDEC"","_$J_")"
K @SDECY
N SDECI,SDECST,%DT,X,Y,ZTDESC,ZTDTH,ZTRTN,ZTSAVE,ZTSK
S SDECI=0
S ^TMP("SDEC",$J,0)="T00010TASK_NUMBER^T00020ERRORID"_$C(30)
;
;Convert beginning and ending dates
;
S X=SDECBEG,%DT="X" D ^%DT S SDECBEG=$P(Y,"."),SDECBEG=SDECBEG-1
I Y=-1 D ERR(SDECI,0,"Routine: SDEC29, Error: Invalid Date") Q
S X=SDECEND,%DT="X" D ^%DT S SDECEND=$P(Y,"."),SDECEND=SDECEND+1
I Y=-1 D ERR(SDECI,0,"Routine: SDEC29, Error: Invalid Date") Q
;
S ZTRTN="ZTM^SDEC29",ZTDTH=$H,ZTDESC="COPY PATIENT APPTS"
S ZTSAVE("SDECBEG")="",ZTSAVE("SDECEND")="",ZTSAVE("SDEC44")="",ZTSAVE("SDECRES")=""
D ^%ZTLOAD
;
S SDECI=SDECI+1
S SDECST=$S($G(ZTSK)>0:"OK",1:"Unable to create task.")
S ^TMP("SDEC",$J,SDECI)=$G(ZTSK)_"^"_SDECST_$C(30)_$C(31)
Q
;
ZTM ;EP
;Taskman entry point
;$O through ^SC(SDEC44,"S",
Q:'$D(ZTSK)
N SDECCNT,SDECIEN,SDECNOD,SDECNOTE,SDECCAN,SDECPAT,SDECLEN,SDECMADE,SDECCLRK,SDECPAT,SDECQUIT
S SDECCNT=0,SDECQUIT=0
S ^TMP("SDEC29",$J,ZTSK)=SDECCNT
;TSTART
F S SDECBEG=$O(^SC(SDEC44,"S",SDECBEG)) Q:'+SDECBEG Q:SDECBEG>SDECEND Q:SDECQUIT D
. S SDECIEN=0 F S SDECIEN=$O(^SC(SDEC44,"S",SDECBEG,1,SDECIEN)) Q:'+SDECIEN Q:SDECQUIT D
. . S SDECNOD=$G(^SC(SDEC44,"S",SDECBEG,1,SDECIEN,0))
. . Q:'+SDECNOD
. . S SDECCAN=$P(SDECNOD,U,9)
. . Q:SDECCAN="C"
. . S SDECPAT=$P(SDECNOD,U)
. . S SDECLEN=$P(SDECNOD,U,2) ;duration in minutes
. . S SDECCLRK=$P(SDECNOD,U,6) ;appt made by (clerk)
. . S SDECMADE=$P(SDECNOD,U,7) ;date appt made
. . S SDECNOTE=$P(SDECNOD,U,4) ;'OTHER' field contains note
. . S SDECCNT=SDECCNT+$$XFER(SDECRES,SDECBEG,SDECPAT,SDECLEN,SDECCLRK,SDECMADE,SDECNOTE)
. . I +SDECCNT,SDECCNT#10=0 S ^TMP("SDEC29",$J,ZTSK)=SDECCNT_" records copied." ;every 10th record
. . I $D(^TMP("SDEC29",$J,ZTSK,"CANCEL")) S SDECQUIT=1 ;Check for cancel flag
. . Q
. Q
;I 'SDECQUIT TCOMMIT
;E TROLLBACK
S ^TMP("SDEC29",$J,ZTSK)=$S(SDECQUIT:"Cancelled. No records copied.",1:"Finished. "_SDECCNT_" records copied.")
Q
;
ZTMERR ;
;TROLLBACK
D ^%ZTER
Q
;
XFER(SDECRES,SDECBEG,SDECPAT,SDECLEN,SDECCLRK,SDECMADE,SDECNOTE) ;EP
;
;Copy record to SDEC APPOINTMENT file
;Return 1 if record copied, otherwise 0
;
;$O Thru ^SDECAPPT to determine if this appt already added
N SDECEND,SDECIEN,SDECFND,SDECPAT2,SDECFDA,SDECIENS
S SDECIEN=0,SDECFND=0
F S SDECIEN=$O(^SDEC(409.84,"ARSRC",SDECRES,SDECBEG,SDECIEN)) Q:'+SDECIEN D Q:SDECFND
. S SDECNOD=$G(^SDEC(409.84,SDECIEN,0))
. Q:'+SDECNOD
. S SDECPAT2=$P(SDECNOD,U,5)
. S SDECFND=0
. I SDECPAT2=SDECPAT S SDECFND=1
. Q
Q:SDECFND 0
;
;Add to SDEC APPOINTMENT
S SDECEND=SDECBEG
;Calculate ending time from beginning time and duration.
S SDECEND=$$ADDMIN(SDECBEG,SDECLEN)
S SDECIENS="+1,"
S SDECFDA(409.84,SDECIENS,.01)=SDECBEG
S SDECFDA(409.84,SDECIENS,.02)=SDECEND
S SDECFDA(409.84,SDECIENS,.05)=SDECPAT
S SDECFDA(409.84,SDECIENS,.07)=SDECRES
S SDECFDA(409.84,SDECIENS,.08)=SDECCLRK
S SDECFDA(409.84,SDECIENS,.09)=SDECMADE
;
K SDECIEN
D UPDATE^DIE("","SDECFDA","SDECIEN","SDECMSG")
S SDECIEN=+$G(SDECIEN(1))
I '+SDECIEN Q 0
;
;Add WP field
I SDECNOTE]"" S SDECNOTE(.5)=SDECNOTE,SDECNOTE="" D
. D WP^DIE(409.84,SDECIEN_",",1,"","SDECNOTE","SDECMSG")
;
Q 1
;
ERR(SDECI,SDECCNT,SDECERR) ;Error processing
S SDECI=SDECI+1
S ^TMP("SDEC",$J,SDECI)=SDECCNT_"^"_SDECERR_$C(30)
S SDECI=SDECI+1
S ^TMP("SDEC",$J,SDECI)=$C(31)
Q
;
ETRAP ;EP Error trap entry
D ^%ZTER
I '$D(SDECI) N SDECI S SDECI=999
S SDECI=SDECI+1
D ERR(SDECI,$G(SDECCNT),"Routine: SDEC29, Error")
Q
;
CPSTAT(SDECY,SDECTSK) ;Copy Appointment Status
;CPSTAT(SDECY,SDECTSK) external parameter tag is in SDEC
;Return status (copied record count) of tasked job having ZTSK=SDECTSK
;
S SDECY="^TMP(""SDEC"","_$J_")"
K @SDECY
N SDECI,SDECCNT
S SDECI=0
S ^TMP("SDEC",$J,0)="T00020RECORD_COUNT^T00020ERRORID"_$C(30)
S SDECCNT=$G(^TMP("SDEC29",$J,SDECTSK))
I SDECCNT["Finished" K ^TMP("SDEC29",$J,SDECTSK)
I SDECCNT["Cancelled" K ^TMP("SDEC29",$J,SDECTSK)
S SDECI=SDECI+1
S ^TMP("SDEC",$J,SDECI)=SDECCNT_"^"_"OK"_$C(30)_$C(31)
Q
;
CPCANC(SDECY,SDECTSK) ;Copy Appointment Cancel
;CPCANC(SDECY,SDECTSK) external parameter tag is in SDEC
;Signal tasked job having ZTSK=SDECTSK to cancel
;Returns current record count of copy process
;
S SDECY="^TMP(""SDEC"","_$J_")"
N SDECI,SDECCNT
S SDECI=0
S ^TMP("SDEC",$J,0)="T00020RECORD_COUNT^T00020ERRORID"_$C(30)
S SDECCNT=$G(^TMP("SDEC29",$J,SDECTSK))
I SDECCNT["FINISHED" K ^TMP("SDEC29",$J,SDECTSK)
E S ^TMP("SDEC29",$J,SDECTSK,"CANCEL")=""
S SDECI=SDECI+1
S ^TMP("SDEC",$J,SDECI)=SDECCNT_"^"_"OK"_$C(30)_$C(31)
Q
;
ADDMIN(SDECSTRT,SDECLEN) ;
;
;Add SDECLEN minutes to time SDECSTRT and return end time
N SDECEND,SDECH,SDECM,SDECSTIM,SDECETIM
S SDECEND=$P(SDECSTRT,".")
;
;Convert start time to minutes past midnight
S SDECSTIM=$P(SDECSTRT,".",2)
S SDECSTIM=SDECSTIM_"0000"
S SDECSTIM=$E(SDECSTIM,1,4)
S SDECH=$E(SDECSTIM,1,2)
S SDECH=SDECH*60
S SDECH=SDECH+$E(SDECSTIM,3,4)
;
;Add duration to find minutes past midnight of end time
S SDECETIM=SDECH+SDECLEN
;
;Convert back to a time
S SDECH=SDECETIM\60
S SDECH="00"_SDECH
S SDECH=$E(SDECH,$L(SDECH)-1,$L(SDECH))
S SDECM=SDECETIM#60
S SDECM="00"_SDECM
S SDECM=$E(SDECM,$L(SDECM)-1,$L(SDECM))
S SDECETIM=SDECH_SDECM
I SDECETIM>2400 S SDECETIM=2400
S $P(SDECEND,".",2)=SDECETIM
Q SDECEND
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDEC29 6114 printed Nov 22, 2024@18:00:25 Page 2
SDEC29 ;ALB/SAT - VISTA SCHEDULING RPCS ;JAN 15, 2016
+1 ;;5.3;Scheduling;**627,740**;Aug 13, 1993;Build 12
+2 ;
+3 QUIT
+4 ;
COPYAPPT(SDECY,SDECRES,SDEC44,SDECBEG,SDECEND) ;Copy appointments from HOSPITAL LOCATION to SDEC RESOURCE
+1 ;COPYAPPT(SDECY,SDECRES,SDEC44,SDECBEG,SDECEND) external parameter tag is in SDEC
+2 ;Copy appointments from HOSPITAL LOCATION entry SDEC44 to SDEC RESOURCE entry SDECRES
+3 ;Beginning with appointments on day SDECBEG and ending on SDECEND, inclusive
+4 ;
+5 ;Returns ADO Recordset formatted fields containing count of records copied and error message:
+6 ;
+7 ;
+8 SET SDECY="^TMP(""SDEC"","_$JOB_")"
+9 KILL @SDECY
+10 NEW SDECI,SDECST,%DT,X,Y,ZTDESC,ZTDTH,ZTRTN,ZTSAVE,ZTSK
+11 SET SDECI=0
+12 SET ^TMP("SDEC",$JOB,0)="T00010TASK_NUMBER^T00020ERRORID"_$CHAR(30)
+13 ;
+14 ;Convert beginning and ending dates
+15 ;
+16 SET X=SDECBEG
SET %DT="X"
DO ^%DT
SET SDECBEG=$PIECE(Y,".")
SET SDECBEG=SDECBEG-1
+17 IF Y=-1
DO ERR(SDECI,0,"Routine: SDEC29, Error: Invalid Date")
QUIT
+18 SET X=SDECEND
SET %DT="X"
DO ^%DT
SET SDECEND=$PIECE(Y,".")
SET SDECEND=SDECEND+1
+19 IF Y=-1
DO ERR(SDECI,0,"Routine: SDEC29, Error: Invalid Date")
QUIT
+20 ;
+21 SET ZTRTN="ZTM^SDEC29"
SET ZTDTH=$HOROLOG
SET ZTDESC="COPY PATIENT APPTS"
+22 SET ZTSAVE("SDECBEG")=""
SET ZTSAVE("SDECEND")=""
SET ZTSAVE("SDEC44")=""
SET ZTSAVE("SDECRES")=""
+23 DO ^%ZTLOAD
+24 ;
+25 SET SDECI=SDECI+1
+26 SET SDECST=$SELECT($GET(ZTSK)>0:"OK",1:"Unable to create task.")
+27 SET ^TMP("SDEC",$JOB,SDECI)=$GET(ZTSK)_"^"_SDECST_$CHAR(30)_$CHAR(31)
+28 QUIT
+29 ;
ZTM ;EP
+1 ;Taskman entry point
+2 ;$O through ^SC(SDEC44,"S",
+3 if '$DATA(ZTSK)
QUIT
+4 NEW SDECCNT,SDECIEN,SDECNOD,SDECNOTE,SDECCAN,SDECPAT,SDECLEN,SDECMADE,SDECCLRK,SDECPAT,SDECQUIT
+5 SET SDECCNT=0
SET SDECQUIT=0
+6 SET ^TMP("SDEC29",$JOB,ZTSK)=SDECCNT
+7 ;TSTART
+8 FOR
SET SDECBEG=$ORDER(^SC(SDEC44,"S",SDECBEG))
if '+SDECBEG
QUIT
if SDECBEG>SDECEND
QUIT
if SDECQUIT
QUIT
Begin DoDot:1
+9 SET SDECIEN=0
FOR
SET SDECIEN=$ORDER(^SC(SDEC44,"S",SDECBEG,1,SDECIEN))
if '+SDECIEN
QUIT
if SDECQUIT
QUIT
Begin DoDot:2
+10 SET SDECNOD=$GET(^SC(SDEC44,"S",SDECBEG,1,SDECIEN,0))
+11 if '+SDECNOD
QUIT
+12 SET SDECCAN=$PIECE(SDECNOD,U,9)
+13 if SDECCAN="C"
QUIT
+14 SET SDECPAT=$PIECE(SDECNOD,U)
+15 ;duration in minutes
SET SDECLEN=$PIECE(SDECNOD,U,2)
+16 ;appt made by (clerk)
SET SDECCLRK=$PIECE(SDECNOD,U,6)
+17 ;date appt made
SET SDECMADE=$PIECE(SDECNOD,U,7)
+18 ;'OTHER' field contains note
SET SDECNOTE=$PIECE(SDECNOD,U,4)
+19 SET SDECCNT=SDECCNT+$$XFER(SDECRES,SDECBEG,SDECPAT,SDECLEN,SDECCLRK,SDECMADE,SDECNOTE)
+20 ;every 10th record
IF +SDECCNT
IF SDECCNT#10=0
SET ^TMP("SDEC29",$JOB,ZTSK)=SDECCNT_" records copied."
+21 ;Check for cancel flag
IF $DATA(^TMP("SDEC29",$JOB,ZTSK,"CANCEL"))
SET SDECQUIT=1
+22 QUIT
End DoDot:2
+23 QUIT
End DoDot:1
+24 ;I 'SDECQUIT TCOMMIT
+25 ;E TROLLBACK
+26 SET ^TMP("SDEC29",$JOB,ZTSK)=$SELECT(SDECQUIT:"Cancelled. No records copied.",1:"Finished. "_SDECCNT_" records copied.")
+27 QUIT
+28 ;
ZTMERR ;
+1 ;TROLLBACK
+2 DO ^%ZTER
+3 QUIT
+4 ;
XFER(SDECRES,SDECBEG,SDECPAT,SDECLEN,SDECCLRK,SDECMADE,SDECNOTE) ;EP
+1 ;
+2 ;Copy record to SDEC APPOINTMENT file
+3 ;Return 1 if record copied, otherwise 0
+4 ;
+5 ;$O Thru ^SDECAPPT to determine if this appt already added
+6 NEW SDECEND,SDECIEN,SDECFND,SDECPAT2,SDECFDA,SDECIENS
+7 SET SDECIEN=0
SET SDECFND=0
+8 FOR
SET SDECIEN=$ORDER(^SDEC(409.84,"ARSRC",SDECRES,SDECBEG,SDECIEN))
if '+SDECIEN
QUIT
Begin DoDot:1
+9 SET SDECNOD=$GET(^SDEC(409.84,SDECIEN,0))
+10 if '+SDECNOD
QUIT
+11 SET SDECPAT2=$PIECE(SDECNOD,U,5)
+12 SET SDECFND=0
+13 IF SDECPAT2=SDECPAT
SET SDECFND=1
+14 QUIT
End DoDot:1
if SDECFND
QUIT
+15 if SDECFND
QUIT 0
+16 ;
+17 ;Add to SDEC APPOINTMENT
+18 SET SDECEND=SDECBEG
+19 ;Calculate ending time from beginning time and duration.
+20 SET SDECEND=$$ADDMIN(SDECBEG,SDECLEN)
+21 SET SDECIENS="+1,"
+22 SET SDECFDA(409.84,SDECIENS,.01)=SDECBEG
+23 SET SDECFDA(409.84,SDECIENS,.02)=SDECEND
+24 SET SDECFDA(409.84,SDECIENS,.05)=SDECPAT
+25 SET SDECFDA(409.84,SDECIENS,.07)=SDECRES
+26 SET SDECFDA(409.84,SDECIENS,.08)=SDECCLRK
+27 SET SDECFDA(409.84,SDECIENS,.09)=SDECMADE
+28 ;
+29 KILL SDECIEN
+30 DO UPDATE^DIE("","SDECFDA","SDECIEN","SDECMSG")
+31 SET SDECIEN=+$GET(SDECIEN(1))
+32 IF '+SDECIEN
QUIT 0
+33 ;
+34 ;Add WP field
+35 IF SDECNOTE]""
SET SDECNOTE(.5)=SDECNOTE
SET SDECNOTE=""
Begin DoDot:1
+36 DO WP^DIE(409.84,SDECIEN_",",1,"","SDECNOTE","SDECMSG")
End DoDot:1
+37 ;
+38 QUIT 1
+39 ;
ERR(SDECI,SDECCNT,SDECERR) ;Error processing
+1 SET SDECI=SDECI+1
+2 SET ^TMP("SDEC",$JOB,SDECI)=SDECCNT_"^"_SDECERR_$CHAR(30)
+3 SET SDECI=SDECI+1
+4 SET ^TMP("SDEC",$JOB,SDECI)=$CHAR(31)
+5 QUIT
+6 ;
ETRAP ;EP Error trap entry
+1 DO ^%ZTER
+2 IF '$DATA(SDECI)
NEW SDECI
SET SDECI=999
+3 SET SDECI=SDECI+1
+4 DO ERR(SDECI,$GET(SDECCNT),"Routine: SDEC29, Error")
+5 QUIT
+6 ;
CPSTAT(SDECY,SDECTSK) ;Copy Appointment Status
+1 ;CPSTAT(SDECY,SDECTSK) external parameter tag is in SDEC
+2 ;Return status (copied record count) of tasked job having ZTSK=SDECTSK
+3 ;
+4 SET SDECY="^TMP(""SDEC"","_$JOB_")"
+5 KILL @SDECY
+6 NEW SDECI,SDECCNT
+7 SET SDECI=0
+8 SET ^TMP("SDEC",$JOB,0)="T00020RECORD_COUNT^T00020ERRORID"_$CHAR(30)
+9 SET SDECCNT=$GET(^TMP("SDEC29",$JOB,SDECTSK))
+10 IF SDECCNT["Finished"
KILL ^TMP("SDEC29",$JOB,SDECTSK)
+11 IF SDECCNT["Cancelled"
KILL ^TMP("SDEC29",$JOB,SDECTSK)
+12 SET SDECI=SDECI+1
+13 SET ^TMP("SDEC",$JOB,SDECI)=SDECCNT_"^"_"OK"_$CHAR(30)_$CHAR(31)
+14 QUIT
+15 ;
CPCANC(SDECY,SDECTSK) ;Copy Appointment Cancel
+1 ;CPCANC(SDECY,SDECTSK) external parameter tag is in SDEC
+2 ;Signal tasked job having ZTSK=SDECTSK to cancel
+3 ;Returns current record count of copy process
+4 ;
+5 SET SDECY="^TMP(""SDEC"","_$JOB_")"
+6 NEW SDECI,SDECCNT
+7 SET SDECI=0
+8 SET ^TMP("SDEC",$JOB,0)="T00020RECORD_COUNT^T00020ERRORID"_$CHAR(30)
+9 SET SDECCNT=$GET(^TMP("SDEC29",$JOB,SDECTSK))
+10 IF SDECCNT["FINISHED"
KILL ^TMP("SDEC29",$JOB,SDECTSK)
+11 IF '$TEST
SET ^TMP("SDEC29",$JOB,SDECTSK,"CANCEL")=""
+12 SET SDECI=SDECI+1
+13 SET ^TMP("SDEC",$JOB,SDECI)=SDECCNT_"^"_"OK"_$CHAR(30)_$CHAR(31)
+14 QUIT
+15 ;
ADDMIN(SDECSTRT,SDECLEN) ;
+1 ;
+2 ;Add SDECLEN minutes to time SDECSTRT and return end time
+3 NEW SDECEND,SDECH,SDECM,SDECSTIM,SDECETIM
+4 SET SDECEND=$PIECE(SDECSTRT,".")
+5 ;
+6 ;Convert start time to minutes past midnight
+7 SET SDECSTIM=$PIECE(SDECSTRT,".",2)
+8 SET SDECSTIM=SDECSTIM_"0000"
+9 SET SDECSTIM=$EXTRACT(SDECSTIM,1,4)
+10 SET SDECH=$EXTRACT(SDECSTIM,1,2)
+11 SET SDECH=SDECH*60
+12 SET SDECH=SDECH+$EXTRACT(SDECSTIM,3,4)
+13 ;
+14 ;Add duration to find minutes past midnight of end time
+15 SET SDECETIM=SDECH+SDECLEN
+16 ;
+17 ;Convert back to a time
+18 SET SDECH=SDECETIM\60
+19 SET SDECH="00"_SDECH
+20 SET SDECH=$EXTRACT(SDECH,$LENGTH(SDECH)-1,$LENGTH(SDECH))
+21 SET SDECM=SDECETIM#60
+22 SET SDECM="00"_SDECM
+23 SET SDECM=$EXTRACT(SDECM,$LENGTH(SDECM)-1,$LENGTH(SDECM))
+24 SET SDECETIM=SDECH_SDECM
+25 IF SDECETIM>2400
SET SDECETIM=2400
+26 SET $PIECE(SDECEND,".",2)=SDECETIM
+27 QUIT SDECEND
