Routine: SDEC08A

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

 ; 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

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

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)

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)

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  Feb 19, 2025@00:16:29                                                                                                                                                                                                     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

SDEC08A.m