SDECAR3 ;ALB/SAT/JSM,JAS - VISTA SCHEDULING RPCS ; OCT 10, 2024
;;5.3;Scheduling;**658,893**;Aug 13, 1993;Build 6
;;Per VHA Directive 6402, this routine should not be modified
;
Q
;
;SDECAR3 AREDIT
AREDIT(RET,TYP,IEN,ATYPE,REQBY,PROV,COMMENT,FAST,LOA,SDCL,SDSTOP) ;Appointment Request Set
; TYP - (required) Request type to edit
; ; A = APPT (SDEC APPT REQUEST)
; ; E = EWL (SD WAIT LIST)
; ; R = RECALL (RECALL REMINDERS)
; IEN - (required) id pointer to:
; ; A = SDEC APPT REQUEST file (#409.85)
; ; E = SD WAIT LIST file (#409.3)
; ; R = RECALL REMINDERS file (#403.5)
; ATYPE - (optional) Appointment Type ID pointer to APPOINTMENT TYPE file 409.1 for APPT and EWL types,
; ID pointer to Recall Reminders Appt Type file 403.51 for RECALL type
; REQBY - (optional) Requested by: 1 = Provider, 2 = Patient
; PROV - (optional) Provider ID pointer to NEW PERSON file (#200) for APPT and EWL types,
; ID pointer to RECALL REMINDERS PROVIDERS file (#403.54) for RECALL REMINDER type
; COMMENT - (optional) comment must be 1-60 characters
; FAST - (optional) Fasting: f = Fasting, n = Non-fasting
; LOA - (optional) Length of Appt. must be a number between 10 and 120, 0 decimal digits
; SDCL - (optional) Clinic code - Pointer to HOSPITAL LOCATION file
; SDSTOP - (optional) CLINIC STOP or Service/Specialty name - NAME from the SD WL SERVICE/SPECIALTY file - looks for 1st active
; OR - Pointer to the CLINIC STOP file
;RETURN:
; CODE ^ MESSAGE
; CODE = IEN of updated record or -1 if error
;
N ERRFLG,FIELDS,SDDFN,SDNE
S ERRFLG=0,SDNE=""
S RET=$NA(^TMP("SDECAR3",$J,"AREDIT"))
K @RET
S @RET@(0)="I00020CODE^T00030MESSAGE"_$C(30)
;validate TYP
S TYP=$G(TYP)
I "AER"'[TYP S @RET@(1)="-1^Invalid Request Type "_TYP_"."_$C(30,31) Q
;validate FAST
S FAST=$G(FAST)
I FAST'="","fnFN"'[FAST S @RET@(1)="-1^Invalid Fasting Code "_FAST_"."_$C(30,31) Q
;validate LOA is a number between 10 and 120
S LOA=$G(LOA)
I +LOA,(LOA>120)!(LOA<10) S @RET@(1)="-1^Invalid Length of Appt. Number should be between 10 and 120 - "_LOA_"."_$C(30,31) Q
;Validate Clinic Code
S SDCL=$G(SDCL)
I SDCL'="",'$D(^SC(SDCL,0)) S @RET@(1)="-1^Invalid Clinic ID "_SDCL_"."_$C(30,31) Q
;Validate Service/Specialty
S SDSTOP=$G(SDSTOP)
I +SDSTOP,'$D(^DIC(40.7,SDSTOP,0)) S @RET@(1)="-1^Invalid Clinic ID "_SDCL_"."_$C(30,31) Q
S ATYPE=$G(ATYPE)
;If REQBY is Patient (2), then clear PROV
S REQBY=$G(REQBY) I REQBY=2 S PROV=""
;validate COMMENT does not contain '^'
S COMMENT=$TR($G(COMMENT),"^"," ")
;validate IEN
S IEN=$G(IEN)
I IEN="" S @RET@(1)="-1^Request Type ien is required."_$C(30,31) Q
D APPT:(TYP="A"),EWL:(TYP="E"),RECALL:(TYP="R")
;
; EXIT
I ERRFLG=0 S @RET@(1)=IEN_"^SUCCESS"_$C(30,31)
K ERRFLG,SDDFN,SDNE
Q
;
;type A. If IEN is valid in SDEC APPT REQUEST file (#409.85) and data has changed,
; then save the edits
APPT ;
;Validate IEN exists
I '$D(^SDEC(409.85,IEN,0)) S @RET@(1)="-1^Invalid APPT id "_IEN_"."_$C(30,31),ERRFLG=1 Q
;Validate Provider IEN exists
I REQBY=1,'$D(^VA(200,PROV,0)) S @RET@(1)="-1^Invalid PROV id for APPT REQ "_PROV_"."_$C(30,31),ERRFLG=1 Q
;check for edits/changes to REQ APPT TYPE, REQUEST BY, PROVIDER, and COMMENTS
K ARDATA,ARERR
S FIELDS=".01;.02;8;8.5;8.7;11;12;25"
D GETS^DIQ(409.85,IEN,FIELDS,"IE","ARDATA","ARERR")
I $D(ARERR) M ARMSG=ARERR K FDA Q
S FDA=$NA(FDA(409.85,IEN))
K @FDA,ARMSG
;setup SDDFN
S SDDFN=ARDATA(409.85,IEN_",",.01,"I")
;If clinic or service/specialty changed, determine if patient is new or established
I +SDCL,SDCL'=ARDATA(409.85,IEN_",",8,"I") D PCSTGET^SDEC50(.SDRET,SDDFN,SDCL) S @FDA@(8)=SDCL
I +SDSTOP,SDSTOP'=ARDATA(409.85,IEN_",",8.5,"I") D PCST2GET^SDEC50(.SDRET,SDDFN,SDSTOP) S @FDA@(8.5)=SDSTOP
I $D(SDRET) S SDNE=$P($P(SDRET(1),U,2),$C(30,31),1),SDNE=$S(SDNE="YES":"N",1:"E")
K SDRET
;setup FDA for the updated inputs
I ATYPE'=ARDATA(409.85,IEN_",",12,"I") S @FDA@(12)=ATYPE
I REQBY'=ARDATA(409.85,IEN_",",11,"I") S @FDA@(11)=REQBY
I PROV'=ARDATA(409.85,IEN_",",8.7,"I") S @FDA@(8.7)=PROV
I COMMENT'=ARDATA(409.85,IEN_",",25,"I") S @FDA@(25)=COMMENT
I SDNE'=ARDATA(409.85,IEN_",",.02,"I") S @FDA@(.02)=SDNE
;update the SDEC APPT REQUEST file (#409.85)
D:$D(@FDA) UPDATE^DIE("","FDA",,"ARMSG")
I $D(ARMSG) S @RET@(1)="-1^Unable to store the changed data"_$C(30,31),ERRFLG=1 Q
;
; 409.85 COMMENTS AUDIT multiple
I $L(COMMENT) D
. N CAFDA
. S CAFDA(409.8527,"+1,"_IEN_",",.01)=$$NOW^XLFDT
. S CAFDA(409.8527,"+1,"_IEN_",",1)=DUZ
. S CAFDA(409.8527,"+1,"_IEN,",",2)=COMMENT
. D UPDATE^DIE("","CAFDA") K CAFDA
Q
;
;
;type E. If IEN is valid in SD WAIT LIST file (#409.3) and data has changed,
; then save edits
EWL ;
; Validate IEN exists
I '$D(^SDWL(409.3,IEN,0)) S @RET@(1)="-1^Invalid Wait List id "_IEN_"."_$C(30,31),ERRFLG=1 Q
;Validate Provider IEN exists
I REQBY=1,'$D(^VA(200,PROV,0)) S @RET@(1)="-1^Invalid PROV id for EWL "_PROV_"."_$C(30,31),ERRFLG=1 Q
;check for edits/changes to REQ APPT TYPE, REQUEST BY, PROVIDER, and COMMENTS
K ARDATA,ARERR
S FIELDS="8.7;11;12;25"
D GETS^DIQ(409.3,IEN,FIELDS,"IE","ARDATA","ARERR")
I $D(ARERR) M ARMSG=ARERR K FDA Q
S FDA=$NA(FDA(409.3,IEN))
K @FDA,ARMSG
;setup FDA for the updated inputs
I ATYPE'=ARDATA(409.3,IEN_",",12,"I") S @FDA@(12)=ATYPE
I REQBY'=ARDATA(409.3,IEN_",",11,"I") S @FDA@(11)=REQBY
I PROV'=ARDATA(409.3,IEN_",",8.7,"I") S @FDA@(8.7)=PROV
I COMMENT'=ARDATA(409.3,IEN_",",25,"I") S @FDA@(25)=COMMENT
;update the SD WAIT LIST file (#409.3)
D:$D(@FDA) UPDATE^DIE("","FDA",,"ARMSG")
I $D(ARMSG) S @RET@(1)="-1^Unable to store the changed data"_$C(30,31),ERRFLG=1 Q
Q
;
;type R. If IEN is valid in RECALL REMINDERS file (#403.5) and data has changed,
; then save edits
RECALL ;
; Validate IEN exists
I '$D(^SD(403.5,IEN,0)) S @RET@(1)="-1^Invalid Recall id "_IEN_"."_$C(30,31),ERRFLG=1 Q
;Validate Provider IEN exists
I REQBY=1,'$D(^SD(403.54,PROV,0)) S @RET@(1)="-1^Invalid PROV id for RECALL REMINDERS PROVIDER "_PROV_"."_$C(30,31),ERRFLG=1 Q
;Ensure FAST is lowercase
S FAST=$$LOW^XLFSTR(FAST)
;check for edits/changes to PROVIDER and COMMENTS
K ARDATA,ARERR
S FIELDS="2.5;2.6;4.5;4.7;3;4"
D GETS^DIQ(403.5,IEN,FIELDS,"IE","ARDATA","ARERR")
I $D(ARERR) M ARMSG=ARERR K FDA Q
S FDA=$NA(FDA(403.5,IEN))
K @FDA,ARMSG
;setup FDA for the updated inputs
I ATYPE'=ARDATA(403.5,IEN_",",3,"I") S @FDA@(3)=ATYPE
I PROV'=ARDATA(403.5,IEN_",",4,"I") S @FDA@(4)=PROV
I FAST'=ARDATA(403.5,IEN_",",2.6,"I") S @FDA@(2.6)=FAST
I COMMENT'=ARDATA(403.5,IEN_",",2.5,"I") S @FDA@(2.5)=COMMENT
I SDCL'=ARDATA(403.5,IEN_",",4.5,"I") S @FDA@(4.5)=SDCL
I LOA'=ARDATA(403.5,IEN_",",4.7,"I") S @FDA@(4.7)=LOA
;update the RECALL REMINDERS file (#403.5)
D:$D(@FDA) UPDATE^DIE("","FDA",,"ARMSG")
I $D(ARMSG) S @RET@(1)="-1^Unable to store the changed data"_$C(30,31),ERRFLG=1 Q
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDECAR3 7202 printed Dec 13, 2024@02:51:46 Page 2
SDECAR3 ;ALB/SAT/JSM,JAS - VISTA SCHEDULING RPCS ; OCT 10, 2024
+1 ;;5.3;Scheduling;**658,893**;Aug 13, 1993;Build 6
+2 ;;Per VHA Directive 6402, this routine should not be modified
+3 ;
+4 QUIT
+5 ;
+6 ;SDECAR3 AREDIT
AREDIT(RET,TYP,IEN,ATYPE,REQBY,PROV,COMMENT,FAST,LOA,SDCL,SDSTOP) ;Appointment Request Set
+1 ; TYP - (required) Request type to edit
+2 ; ; A = APPT (SDEC APPT REQUEST)
+3 ; ; E = EWL (SD WAIT LIST)
+4 ; ; R = RECALL (RECALL REMINDERS)
+5 ; IEN - (required) id pointer to:
+6 ; ; A = SDEC APPT REQUEST file (#409.85)
+7 ; ; E = SD WAIT LIST file (#409.3)
+8 ; ; R = RECALL REMINDERS file (#403.5)
+9 ; ATYPE - (optional) Appointment Type ID pointer to APPOINTMENT TYPE file 409.1 for APPT and EWL types,
+10 ; ID pointer to Recall Reminders Appt Type file 403.51 for RECALL type
+11 ; REQBY - (optional) Requested by: 1 = Provider, 2 = Patient
+12 ; PROV - (optional) Provider ID pointer to NEW PERSON file (#200) for APPT and EWL types,
+13 ; ID pointer to RECALL REMINDERS PROVIDERS file (#403.54) for RECALL REMINDER type
+14 ; COMMENT - (optional) comment must be 1-60 characters
+15 ; FAST - (optional) Fasting: f = Fasting, n = Non-fasting
+16 ; LOA - (optional) Length of Appt. must be a number between 10 and 120, 0 decimal digits
+17 ; SDCL - (optional) Clinic code - Pointer to HOSPITAL LOCATION file
+18 ; SDSTOP - (optional) CLINIC STOP or Service/Specialty name - NAME from the SD WL SERVICE/SPECIALTY file - looks for 1st active
+19 ; OR - Pointer to the CLINIC STOP file
+20 ;RETURN:
+21 ; CODE ^ MESSAGE
+22 ; CODE = IEN of updated record or -1 if error
+23 ;
+24 NEW ERRFLG,FIELDS,SDDFN,SDNE
+25 SET ERRFLG=0
SET SDNE=""
+26 SET RET=$NAME(^TMP("SDECAR3",$JOB,"AREDIT"))
+27 KILL @RET
+28 SET @RET@(0)="I00020CODE^T00030MESSAGE"_$CHAR(30)
+29 ;validate TYP
+30 SET TYP=$GET(TYP)
+31 IF "AER"'[TYP
SET @RET@(1)="-1^Invalid Request Type "_TYP_"."_$CHAR(30,31)
QUIT
+32 ;validate FAST
+33 SET FAST=$GET(FAST)
+34 IF FAST'=""
IF "fnFN"'[FAST
SET @RET@(1)="-1^Invalid Fasting Code "_FAST_"."_$CHAR(30,31)
QUIT
+35 ;validate LOA is a number between 10 and 120
+36 SET LOA=$GET(LOA)
+37 IF +LOA
IF (LOA>120)!(LOA<10)
SET @RET@(1)="-1^Invalid Length of Appt. Number should be between 10 and 120 - "_LOA_"."_$CHAR(30,31)
QUIT
+38 ;Validate Clinic Code
+39 SET SDCL=$GET(SDCL)
+40 IF SDCL'=""
IF '$DATA(^SC(SDCL,0))
SET @RET@(1)="-1^Invalid Clinic ID "_SDCL_"."_$CHAR(30,31)
QUIT
+41 ;Validate Service/Specialty
+42 SET SDSTOP=$GET(SDSTOP)
+43 IF +SDSTOP
IF '$DATA(^DIC(40.7,SDSTOP,0))
SET @RET@(1)="-1^Invalid Clinic ID "_SDCL_"."_$CHAR(30,31)
QUIT
+44 SET ATYPE=$GET(ATYPE)
+45 ;If REQBY is Patient (2), then clear PROV
+46 SET REQBY=$GET(REQBY)
IF REQBY=2
SET PROV=""
+47 ;validate COMMENT does not contain '^'
+48 SET COMMENT=$TRANSLATE($GET(COMMENT),"^"," ")
+49 ;validate IEN
+50 SET IEN=$GET(IEN)
+51 IF IEN=""
SET @RET@(1)="-1^Request Type ien is required."_$CHAR(30,31)
QUIT
+52 if (TYP="A")
DO APPT
if (TYP="E")
DO EWL
if (TYP="R")
DO RECALL
+53 ;
+54 ; EXIT
+55 IF ERRFLG=0
SET @RET@(1)=IEN_"^SUCCESS"_$CHAR(30,31)
+56 KILL ERRFLG,SDDFN,SDNE
+57 QUIT
+58 ;
+59 ;type A. If IEN is valid in SDEC APPT REQUEST file (#409.85) and data has changed,
+60 ; then save the edits
APPT ;
+1 ;Validate IEN exists
+2 IF '$DATA(^SDEC(409.85,IEN,0))
SET @RET@(1)="-1^Invalid APPT id "_IEN_"."_$CHAR(30,31)
SET ERRFLG=1
QUIT
+3 ;Validate Provider IEN exists
+4 IF REQBY=1
IF '$DATA(^VA(200,PROV,0))
SET @RET@(1)="-1^Invalid PROV id for APPT REQ "_PROV_"."_$CHAR(30,31)
SET ERRFLG=1
QUIT
+5 ;check for edits/changes to REQ APPT TYPE, REQUEST BY, PROVIDER, and COMMENTS
+6 KILL ARDATA,ARERR
+7 SET FIELDS=".01;.02;8;8.5;8.7;11;12;25"
+8 DO GETS^DIQ(409.85,IEN,FIELDS,"IE","ARDATA","ARERR")
+9 IF $DATA(ARERR)
MERGE ARMSG=ARERR
KILL FDA
QUIT
+10 SET FDA=$NAME(FDA(409.85,IEN))
+11 KILL @FDA,ARMSG
+12 ;setup SDDFN
+13 SET SDDFN=ARDATA(409.85,IEN_",",.01,"I")
+14 ;If clinic or service/specialty changed, determine if patient is new or established
+15 IF +SDCL
IF SDCL'=ARDATA(409.85,IEN_",",8,"I")
DO PCSTGET^SDEC50(.SDRET,SDDFN,SDCL)
SET @FDA@(8)=SDCL
+16 IF +SDSTOP
IF SDSTOP'=ARDATA(409.85,IEN_",",8.5,"I")
DO PCST2GET^SDEC50(.SDRET,SDDFN,SDSTOP)
SET @FDA@(8.5)=SDSTOP
+17 IF $DATA(SDRET)
SET SDNE=$PIECE($PIECE(SDRET(1),U,2),$CHAR(30,31),1)
SET SDNE=$SELECT(SDNE="YES":"N",1:"E")
+18 KILL SDRET
+19 ;setup FDA for the updated inputs
+20 IF ATYPE'=ARDATA(409.85,IEN_",",12,"I")
SET @FDA@(12)=ATYPE
+21 IF REQBY'=ARDATA(409.85,IEN_",",11,"I")
SET @FDA@(11)=REQBY
+22 IF PROV'=ARDATA(409.85,IEN_",",8.7,"I")
SET @FDA@(8.7)=PROV
+23 IF COMMENT'=ARDATA(409.85,IEN_",",25,"I")
SET @FDA@(25)=COMMENT
+24 IF SDNE'=ARDATA(409.85,IEN_",",.02,"I")
SET @FDA@(.02)=SDNE
+25 ;update the SDEC APPT REQUEST file (#409.85)
+26 if $DATA(@FDA)
DO UPDATE^DIE("","FDA",,"ARMSG")
+27 IF $DATA(ARMSG)
SET @RET@(1)="-1^Unable to store the changed data"_$CHAR(30,31)
SET ERRFLG=1
QUIT
+28 ;
+29 ; 409.85 COMMENTS AUDIT multiple
+30 IF $LENGTH(COMMENT)
Begin DoDot:1
+31 NEW CAFDA
+32 SET CAFDA(409.8527,"+1,"_IEN_",",.01)=$$NOW^XLFDT
+33 SET CAFDA(409.8527,"+1,"_IEN_",",1)=DUZ
+34 SET CAFDA(409.8527,"+1,"_IEN,",",2)=COMMENT
+35 DO UPDATE^DIE("","CAFDA")
KILL CAFDA
End DoDot:1
+36 QUIT
+37 ;
+38 ;
+39 ;type E. If IEN is valid in SD WAIT LIST file (#409.3) and data has changed,
+40 ; then save edits
EWL ;
+1 ; Validate IEN exists
+2 IF '$DATA(^SDWL(409.3,IEN,0))
SET @RET@(1)="-1^Invalid Wait List id "_IEN_"."_$CHAR(30,31)
SET ERRFLG=1
QUIT
+3 ;Validate Provider IEN exists
+4 IF REQBY=1
IF '$DATA(^VA(200,PROV,0))
SET @RET@(1)="-1^Invalid PROV id for EWL "_PROV_"."_$CHAR(30,31)
SET ERRFLG=1
QUIT
+5 ;check for edits/changes to REQ APPT TYPE, REQUEST BY, PROVIDER, and COMMENTS
+6 KILL ARDATA,ARERR
+7 SET FIELDS="8.7;11;12;25"
+8 DO GETS^DIQ(409.3,IEN,FIELDS,"IE","ARDATA","ARERR")
+9 IF $DATA(ARERR)
MERGE ARMSG=ARERR
KILL FDA
QUIT
+10 SET FDA=$NAME(FDA(409.3,IEN))
+11 KILL @FDA,ARMSG
+12 ;setup FDA for the updated inputs
+13 IF ATYPE'=ARDATA(409.3,IEN_",",12,"I")
SET @FDA@(12)=ATYPE
+14 IF REQBY'=ARDATA(409.3,IEN_",",11,"I")
SET @FDA@(11)=REQBY
+15 IF PROV'=ARDATA(409.3,IEN_",",8.7,"I")
SET @FDA@(8.7)=PROV
+16 IF COMMENT'=ARDATA(409.3,IEN_",",25,"I")
SET @FDA@(25)=COMMENT
+17 ;update the SD WAIT LIST file (#409.3)
+18 if $DATA(@FDA)
DO UPDATE^DIE("","FDA",,"ARMSG")
+19 IF $DATA(ARMSG)
SET @RET@(1)="-1^Unable to store the changed data"_$CHAR(30,31)
SET ERRFLG=1
QUIT
+20 QUIT
+21 ;
+22 ;type R. If IEN is valid in RECALL REMINDERS file (#403.5) and data has changed,
+23 ; then save edits
RECALL ;
+1 ; Validate IEN exists
+2 IF '$DATA(^SD(403.5,IEN,0))
SET @RET@(1)="-1^Invalid Recall id "_IEN_"."_$CHAR(30,31)
SET ERRFLG=1
QUIT
+3 ;Validate Provider IEN exists
+4 IF REQBY=1
IF '$DATA(^SD(403.54,PROV,0))
SET @RET@(1)="-1^Invalid PROV id for RECALL REMINDERS PROVIDER "_PROV_"."_$CHAR(30,31)
SET ERRFLG=1
QUIT
+5 ;Ensure FAST is lowercase
+6 SET FAST=$$LOW^XLFSTR(FAST)
+7 ;check for edits/changes to PROVIDER and COMMENTS
+8 KILL ARDATA,ARERR
+9 SET FIELDS="2.5;2.6;4.5;4.7;3;4"
+10 DO GETS^DIQ(403.5,IEN,FIELDS,"IE","ARDATA","ARERR")
+11 IF $DATA(ARERR)
MERGE ARMSG=ARERR
KILL FDA
QUIT
+12 SET FDA=$NAME(FDA(403.5,IEN))
+13 KILL @FDA,ARMSG
+14 ;setup FDA for the updated inputs
+15 IF ATYPE'=ARDATA(403.5,IEN_",",3,"I")
SET @FDA@(3)=ATYPE
+16 IF PROV'=ARDATA(403.5,IEN_",",4,"I")
SET @FDA@(4)=PROV
+17 IF FAST'=ARDATA(403.5,IEN_",",2.6,"I")
SET @FDA@(2.6)=FAST
+18 IF COMMENT'=ARDATA(403.5,IEN_",",2.5,"I")
SET @FDA@(2.5)=COMMENT
+19 IF SDCL'=ARDATA(403.5,IEN_",",4.5,"I")
SET @FDA@(4.5)=SDCL
+20 IF LOA'=ARDATA(403.5,IEN_",",4.7,"I")
SET @FDA@(4.7)=LOA
+21 ;update the RECALL REMINDERS file (#403.5)
+22 if $DATA(@FDA)
DO UPDATE^DIE("","FDA",,"ARMSG")
+23 IF $DATA(ARMSG)
SET @RET@(1)="-1^Unable to store the changed data"_$CHAR(30,31)
SET ERRFLG=1
QUIT
+24 QUIT
