SDEC08A ;ALB/PWC,BWF - VISTA SCHEDULING RPCS ;Aug 10, 2020@09:30
;;5.3;Scheduling;**745,756,886**;Aug 13, 1993;Build 13
;;Per VHA Directive 2004-038, this routine should not be 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 SDECC,%H
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^SDEC08(.SDECC) ;PWC - changed to call routine SDEC08, code was previously in that routine before split *745
Q
;
SDECUCAN(SDECAPTID) ;called internally to update SDEC APPOINTMENT by clearing cancel date/time
N PROVIEN,SDAPTYP,SDCL,SDRES,SDECIENS
S SDECIENS=SDECAPTID_","
S SDECFDA(409.84,SDECIENS,.12)=""
K SDECMSG
D FILE^DIE("","SDECFDA","SDECMSG")
S SDAPTYP=$$GET1^DIQ(409.84,SDECAPTID_",",.22,"I")
I $P(SDAPTYP,";",2)="GMR(123," D
.S SDCL=$$SDCL^SDECUTL(SDECAPTID)
.S PROVIEN=$$GET1^DIQ(44,SDCL_",",16,"I")
.D REQSET^SDEC07A($P(SDAPTYP,";",1),PROVIEN,"",1)
Q
;
APUCAN(SDECZ,SDECLOC,SDECPATID,SDECSTART,SDECDAM,SDECDEC,SDECLEN,SDECNOTE,SDECRES,SDECWKIN) ;
;un-Cancel appointment for patient SDECDFN in clinic SDECSC1
; SDECLOC = pointer to hospital location ^SC file 44
; SDECPATID = pointer to VA Patient ^DPT file 2
; SDECSTART = Appointment time
; SDECDAM = Date appointment made in FM format
; SDECDEC = Data entry clerk - pointer to NEW PERSON file 200
N SDECC,%H
S SDECC("PAT")=SDECPATID
S SDECC("CLN")=SDECLOC
S SDECC("ADT")=SDECSTART
S SDECC("NOTE")=SDECNOTE ;user note
S SDECC("RES")=SDECRES
S SDECC("USR")=DUZ
S SDECC("LEN")=SDECLEN
S SDECC("WKIN")=SDECWKIN
;
S SDECZ=$$UNCANCEL(.SDECC)
Q
;
UNCANCEL(BSDR) ;PEP; called to un-cancel appt
; Make call using: S ERR=$$UNCANCEL(.ARRAY)
;
; Input Array -
; BSDR("PAT") = ien of patient in file 2
; BSDR("CLN") = ien of clinic in file 44
; BSDR("ADT") = appointment date and time
; BSDR("USR") = user who un-canceled appt
; BSDR("NOTE") = appointment note from SDEC APPOINTMENT
; BSDR("LEN") = appt length in minutes (numeric)
; BSDR("RES") = resource
; BSDR("WKIN")= walk-in
;
;Output: error status and message
; = 0 or null: everything okay
; = 1^message: error and reason
;
N DPTNOD,DPTNODR,SDECERR
I '$D(^DPT(+$G(BSDR("PAT")),0)) Q 1_U_"Patient not on file: "_$G(BSDR("PAT"))
I '$D(^SC(+$G(BSDR("CLN")),0)) Q 1_U_"Clinic not on file: "_$G(BSDR("CLN"))
I $G(BSDR("ADT"))'?7N1"."1N.N Q 1_U_"Appt Date/Time error: "_$G(BSDR("ADT")) ;PWC allow any time combination of numbers #694
I '$D(^VA(200,+$G(BSDR("USR")),0)) Q 1_U_"User Who Canceled Appt Error: "_$G(BSDR("USR"))
;
S SDECERR=$$APPVISTA^SDEC07B(BSDR("LEN"),BSDR("NOTE"),BSDR("PAT"),BSDR("RES"),BSDR("ADT"),BSDR("WKIN"),BSDR("CLN"),.SDECI) ;alb/sat 665 APPVISTA moved to SDEC07B
Q SDECERR
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDEC08A 3765 printed Dec 13, 2024@02:50:03 Page 2
SDEC08A ;ALB/PWC,BWF - VISTA SCHEDULING RPCS ;Aug 10, 2020@09:30
+1 ;;5.3;Scheduling;**745,756,886**;Aug 13, 1993;Build 13
+2 ;;Per VHA Directive 2004-038, this routine should not be modified
+3 ;
+4 QUIT
+5 ; called from ^SDEC08 - routine was too big and had to split *745/*756
+6 ;
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 SDECC,%H
+3 SET SDECC("PAT")=SDECDFN
+4 SET SDECC("CLN")=SDECLOC
+5 SET SDECC("TYP")=SDECTYP
+6 SET SDECC("ADT")=SDECSD
+7 SET %H=$HOROLOG
DO YMD^%DTC
+8 ;X+%
SET SDECC("CDT")=SDECDATE
+9 SET SDECC("NOT")=SDECNOT
+10 if +SDECCR
SET SDECC("CR")=SDECCR
+11 SET SDECC("USR")=SDUSER
+12 ;PWC - changed to call routine SDEC08, code was previously in that routine before split *745
SET SDECZ=$$CANCEL^SDEC08(.SDECC)
+13 QUIT
+14 ;
SDECUCAN(SDECAPTID) ;called internally to update SDEC APPOINTMENT by clearing cancel date/time
+1 NEW PROVIEN,SDAPTYP,SDCL,SDRES,SDECIENS
+2 SET SDECIENS=SDECAPTID_","
+3 SET SDECFDA(409.84,SDECIENS,.12)=""
+4 KILL SDECMSG
+5 DO FILE^DIE("","SDECFDA","SDECMSG")
+6 SET SDAPTYP=$$GET1^DIQ(409.84,SDECAPTID_",",.22,"I")
+7 IF $PIECE(SDAPTYP,";",2)="GMR(123,"
Begin DoDot:1
+8 SET SDCL=$$SDCL^SDECUTL(SDECAPTID)
+9 SET PROVIEN=$$GET1^DIQ(44,SDCL_",",16,"I")
+10 DO REQSET^SDEC07A($PIECE(SDAPTYP,";",1),PROVIEN,"",1)
End DoDot:1
+11 QUIT
+12 ;
APUCAN(SDECZ,SDECLOC,SDECPATID,SDECSTART,SDECDAM,SDECDEC,SDECLEN,SDECNOTE,SDECRES,SDECWKIN) ;
+1 ;un-Cancel appointment for patient SDECDFN in clinic SDECSC1
+2 ; SDECLOC = pointer to hospital location ^SC file 44
+3 ; SDECPATID = pointer to VA Patient ^DPT file 2
+4 ; SDECSTART = Appointment time
+5 ; SDECDAM = Date appointment made in FM format
+6 ; SDECDEC = Data entry clerk - pointer to NEW PERSON file 200
+7 NEW SDECC,%H
+8 SET SDECC("PAT")=SDECPATID
+9 SET SDECC("CLN")=SDECLOC
+10 SET SDECC("ADT")=SDECSTART
+11 ;user note
SET SDECC("NOTE")=SDECNOTE
+12 SET SDECC("RES")=SDECRES
+13 SET SDECC("USR")=DUZ
+14 SET SDECC("LEN")=SDECLEN
+15 SET SDECC("WKIN")=SDECWKIN
+16 ;
+17 SET SDECZ=$$UNCANCEL(.SDECC)
+18 QUIT
+19 ;
UNCANCEL(BSDR) ;PEP; called to un-cancel appt
+1 ; Make call using: S ERR=$$UNCANCEL(.ARRAY)
+2 ;
+3 ; Input Array -
+4 ; BSDR("PAT") = ien of patient in file 2
+5 ; BSDR("CLN") = ien of clinic in file 44
+6 ; BSDR("ADT") = appointment date and time
+7 ; BSDR("USR") = user who un-canceled appt
+8 ; BSDR("NOTE") = appointment note from SDEC APPOINTMENT
+9 ; BSDR("LEN") = appt length in minutes (numeric)
+10 ; BSDR("RES") = resource
+11 ; BSDR("WKIN")= walk-in
+12 ;
+13 ;Output: error status and message
+14 ; = 0 or null: everything okay
+15 ; = 1^message: error and reason
+16 ;
+17 NEW DPTNOD,DPTNODR,SDECERR
+18 IF '$DATA(^DPT(+$GET(BSDR("PAT")),0))
QUIT 1_U_"Patient not on file: "_$GET(BSDR("PAT"))
+19 IF '$DATA(^SC(+$GET(BSDR("CLN")),0))
QUIT 1_U_"Clinic not on file: "_$GET(BSDR("CLN"))
+20 ;PWC allow any time combination of numbers #694
IF $GET(BSDR("ADT"))'?7N1"."1N.N
QUIT 1_U_"Appt Date/Time error: "_$GET(BSDR("ADT"))
+21 IF '$DATA(^VA(200,+$GET(BSDR("USR")),0))
QUIT 1_U_"User Who Canceled Appt Error: "_$GET(BSDR("USR"))
+22 ;
+23 ;alb/sat 665 APPVISTA moved to SDEC07B
SET SDECERR=$$APPVISTA^SDEC07B(BSDR("LEN"),BSDR("NOTE"),BSDR("PAT"),BSDR("RES"),BSDR("ADT"),BSDR("WKIN"),BSDR("CLN"),.SDECI)
+24 QUIT SDECERR
