EHMSDC8A ;ALB/SAT/JSM,WTC,LAB,LEG,RRM,MGD - DELETE APPTS ; Jun 18, 2024@15:21:43
;;1.0;ELECTRONIC HEALTH MODERNIZATION;**13**;Apr 19, 2021;Build 27
;
; Cloned from SDEC08A then modified.
;
Q
; called from ^SDEC08 - routine was too big and had to split *745/*756
;
AVUPDT(SDECSCD,SDECSTART,SDECLEN) ;Update Clinic availability
;See SDCNP0
N HSI,I,S,SB,SD,SDDIF,SI,SL,SS,ST,STARTDAY,STR,X,Y
S (SD,S)=SDECSTART
S I=SDECSCD
Q:'$D(^SC(I,"ST",SD\1,1))
S SL=^SC(I,"SL"),X=$P(SL,U,3),STARTDAY=$S($L(X):X,1:8),SB=STARTDAY-1/100,X=$P(SL,U,6),HSI=$S(X:X,1:4),SI=$S(X="":4,X<3:4,X:X,1:4),STR="#@!$* XXWVUTSRQPONMLKJIHGFEDCBA0123456789jklmnopqrstuvwxyz",SDDIF=$S(HSI<3:8/HSI,1:2)
S SL=SDECLEN
S S=^SC(I,"ST",SD\1,1),Y=SD#1-SB*100,ST=Y#1*SI\.6+(Y\1*SI),SS=SL*HSI/60
I Y'<1 F I=ST+ST:SDDIF S Y=$E(STR,$F(STR,$E(S,I+1))) Q:Y="" S S=$E(S,1,I)_Y_$E(S,I+2,999),SS=SS-1 Q:SS'>0
S ^SC(SDECSCD,"ST",SD\1,1)=S
Q
;
APCAN(SDECZ,SDECLOC,SDECDFN,SDECSD,SDECAPTID,SDECLEN) ;
;Cancel appointment for patient SDECDFN in clinic SDECSC1 at time SDECSD
N SDECPNOD,SDECC,DA,DIE,DPTST,DR,%H
;save data into SDEC APPOINTMENT in case of un-cancel (status & appt length)
S SDECPNOD=$G(^DPT(SDECPATID,"S",SDECSD,0)) I SDECPNOD="" S SDECZ="" Q ; BAD DATA WTC 6/18/2024
S DPTST=$P(SDECPNOD,U,2)
S DIE=409.84
S DA=SDECAPTID
S DR=".17///"_DPTST_";"_".18///"_SDECLEN
D ^DIE
S SDECC("PAT")=SDECDFN
S SDECC("CLN")=SDECLOC
S SDECC("TYP")=SDECTYP
S SDECC("ADT")=SDECSD
S %H=$H D YMD^%DTC
S SDECC("CDT")=SDECDATE ;X+%
S SDECC("NOT")=SDECNOT
S:+SDECCR SDECC("CR")=SDECCR
S SDECC("USR")=SDUSER
S SDECZ=$$CANCEL^EHMSDEC8(.SDECC) ;PWC - changed to call routine SDEC08, code was previously in that routine before split *745
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HEHMSDC8A 1766 printed Apr 22, 2026@13:48:26 Page 2
EHMSDC8A ;ALB/SAT/JSM,WTC,LAB,LEG,RRM,MGD - DELETE APPTS ; Jun 18, 2024@15:21:43
+1 ;;1.0;ELECTRONIC HEALTH MODERNIZATION;**13**;Apr 19, 2021;Build 27
+2 ;
+3 ; Cloned from SDEC08A then modified.
+4 ;
+5 QUIT
+6 ; called from ^SDEC08 - routine was too big and had to split *745/*756
+7 ;
AVUPDT(SDECSCD,SDECSTART,SDECLEN) ;Update Clinic availability
+1 ;See SDCNP0
+2 NEW HSI,I,S,SB,SD,SDDIF,SI,SL,SS,ST,STARTDAY,STR,X,Y
+3 SET (SD,S)=SDECSTART
+4 SET I=SDECSCD
+5 if '$DATA(^SC(I,"ST",SD\1,1))
QUIT
+6 SET SL=^SC(I,"SL")
SET X=$PIECE(SL,U,3)
SET STARTDAY=$SELECT($LENGTH(X):X,1:8)
SET SB=STARTDAY-1/100
SET X=$PIECE(SL,U,6)
SET HSI=$SELECT(X:X,1:4)
SET SI=$SELECT(X="":4,X<3:4,X:X,1:4)
SET STR="#@!$* XXWVUTSRQPONMLKJIHGFEDCBA0123456789jklmnopqrstuvwxyz"
SET SDDIF=$SELECT(HSI<3:8/HSI,1:2)
+7 SET SL=SDECLEN
+8 SET S=^SC(I,"ST",SD\1,1)
SET Y=SD#1-SB*100
SET ST=Y#1*SI\.6+(Y\1*SI)
SET SS=SL*HSI/60
+9 IF Y'<1
FOR I=ST+ST:SDDIF
SET Y=$EXTRACT(STR,$FIND(STR,$EXTRACT(S,I+1)))
if Y=""
QUIT
SET S=$EXTRACT(S,1,I)_Y_$EXTRACT(S,I+2,999)
SET SS=SS-1
if SS'>0
QUIT
+10 SET ^SC(SDECSCD,"ST",SD\1,1)=S
+11 QUIT
+12 ;
APCAN(SDECZ,SDECLOC,SDECDFN,SDECSD,SDECAPTID,SDECLEN) ;
+1 ;Cancel appointment for patient SDECDFN in clinic SDECSC1 at time SDECSD
+2 NEW SDECPNOD,SDECC,DA,DIE,DPTST,DR,%H
+3 ;save data into SDEC APPOINTMENT in case of un-cancel (status & appt length)
+4 ; BAD DATA WTC 6/18/2024
SET SDECPNOD=$GET(^DPT(SDECPATID,"S",SDECSD,0))
IF SDECPNOD=""
SET SDECZ=""
QUIT
+5 SET DPTST=$PIECE(SDECPNOD,U,2)
+6 SET DIE=409.84
+7 SET DA=SDECAPTID
+8 SET DR=".17///"_DPTST_";"_".18///"_SDECLEN
+9 DO ^DIE
+10 SET SDECC("PAT")=SDECDFN
+11 SET SDECC("CLN")=SDECLOC
+12 SET SDECC("TYP")=SDECTYP
+13 SET SDECC("ADT")=SDECSD
+14 SET %H=$HOROLOG
DO YMD^%DTC
+15 ;X+%
SET SDECC("CDT")=SDECDATE
+16 SET SDECC("NOT")=SDECNOT
+17 if +SDECCR
SET SDECC("CR")=SDECCR
+18 SET SDECC("USR")=SDUSER
+19 ;PWC - changed to call routine SDEC08, code was previously in that routine before split *745
SET SDECZ=$$CANCEL^EHMSDEC8(.SDECC)
+20 QUIT
+21 ;
