SDEC07B ;ALB/SAT,PC - VISTA SCHEDULING RPCS ;Feb 27, 2020@14:33
;;5.3;Scheduling;**627,658,665,669,717,722,744,694**;Aug 13, 1993;Build 61
;;Per VHA Directive 2004-038, this routine should not be modified
;
Q
;
MAKE(BSDR) ;PEP; call to store appt made
;
; Make call using: S ERR=$$MAKE^SDEC07B(.ARRAY)
;
; Input Array -
; BSDR("PAT") = ien of patient in file 2
; BSDR("CLN") = ien of clinic in file 44
; BSDR("TYP") = C&P if appointment type is C&P, 3 for scheduled appts, 4 for walkins
; BSDR("COL") = collateral if appointment type is COLLATERAL OF VET.
; BSDR("APT") = Appointment type pointer to APPOINTMENT TYPE file 409.1
; BSDR("ADT") = appointment date and time
; BSDR("LEN") = appointment length in minutes (5-120)
; BSDR("OI") = reason for appt - up to 150 characters
; BSDR("USR") = user who made appt
; BSDR("RES") = resource pointer to SDEC RESOURCE ^SDEC(409.831,
; BSDR("MTR") = MTRC flag (multiple appointments) 0=False (default) 1=True
; BSDR("DDT") = Desired Date of Appt in fm format
; BSDR("REQ") = Requested By - valid values are 1=PROVIDER 2=PATIENT or ""
; BSDR("LAB") = LAB date/time in fm format
; BSDR("EKG") = EKG date/time in fm format
; BSDR("XRA") = XRAY date/time in fm format
; BSDR("CON") = Consult link - pointer to file 123
; BSDR("OVB") = overbook flag - 1=yes, this is an overbook
; BSDR("ELG") = Patient Eligibilty
;
;Output: error status and message
; = 0 or null: everything okay
; = 1^message: error and reason
;
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 "1234"'[$G(BSDR("TYP")) Q 1_U_"Appt Type error: "_$G(BSDR("TYP"))
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 ($G(BSDR("LEN"))<5)!($G(BSDR("LEN"))>240) Q 1_U_"Appt Length error: "_$G(BSDR("LEN"))
I '$D(^VA(200,+$G(BSDR("USR")),0)) Q 1_U_"User Who Made Appt Error: "_$G(BSDR("USR"))
; ICR #10035 wtc 715 5/30/2019
I $D(^DPT(BSDR("PAT"),"S",BSDR("ADT"),0)),$P(^DPT(BSDR("PAT"),"S",BSDR("ADT"),0),U,2)'="C",$P(^DPT(BSDR("PAT"),"S",BSDR("ADT"),0),U,2)'="PC" Q 1_U_"Patient "_$$GET1^DIQ(2,BSDR("PAT")_",",.01)_" already has appt at "_$$FMTE^XLFDT(BSDR("ADT"))
;
N DIC,DA,Y,X,DD,DO,DLAYGO
N SDECERR
N SDFU,SDNA,SDRET,SDSRT
;
S BSDR("APT")=+$G(BSDR("APT"))
S BSDR("COL")=+$G(BSDR("COL"))
;get scheduling request type AND next ava. appt. indicator
S SDSRT=$$SDSRT(BSDR("TYP"),BSDR("MTR"),BSDR("DDT"),BSDR("REQ"))
; next ava.appt. indicator field 26
S SDNA=$P(SDSRT,U,2)
; scheduling request type field 25
S SDSRT=$P(SDSRT,U,1)
;determine if Follow-up visit field 28
S SDRET=""
D PCSTGET^SDEC(.SDRET,BSDR("PAT"),BSDR("CLN"))
S SDFU=$P($P(@SDRET@(1),U,2),$C(30,31),1)
S SDFU=$S(SDFU="YES":1,1:0)
K @SDRET
;store
N SDECCOND ; 722/717 wtc 3/26/2019
S SDECCOND=0 I $D(^DPT(BSDR("PAT"),"S",BSDR("ADT"),0)),(($P(^DPT(BSDR("PAT"),"S",BSDR("ADT"),0),U,2)="C")!($P(^DPT(BSDR("PAT"),"S",BSDR("ADT"),0),U,2)="PC")) S SDECCOND=1 ; ICR #10035 wtc 715 5/30/2019
I SDECCOND=1 D
. ; "un-cancel" existing appt in file 2
. N SDECFDA,SDECIENS,SDECMSG
. S SDECIENS=BSDR("ADT")_","_BSDR("PAT")_","
. S SDECFDA(2.98,SDECIENS,".01")=$$NULLDEL(BSDR("CLN")) ;*zeb+19 722 2/19/19 completely replace old appt's data if overlaying; prevent chimera appt
. S SDECFDA(2.98,SDECIENS,"3")=$$NULLDEL($S($G(^DPT(+$G(BSDR("PAT")),.1))'="":"I",1:""))
. S SDECFDA(2.98,SDECIENS,"5")=$$NULLDEL(BSDR("LAB")) ;lab date/time
. S SDECFDA(2.98,SDECIENS,"6")=$$NULLDEL(BSDR("XRA")) ;xray date/time
. S SDECFDA(2.98,SDECIENS,"7")=$$NULLDEL(BSDR("EKG")) ;ekg date/time
. S SDECFDA(2.98,SDECIENS,"9")=$$NULLDEL(BSDR("TYP"))
. S SDECFDA(2.98,SDECIENS,"9.5")=$$NULLDEL(BSDR("APT"))
. S SDECFDA(2.98,SDECIENS,"13")=$$NULLDEL(BSDR("COL"))
. S SDECFDA(2.98,SDECIENS,"14")="@"
. S SDECFDA(2.98,SDECIENS,"15")="@"
. S SDECFDA(2.98,SDECIENS,"16")="@"
. S SDECFDA(2.98,SDECIENS,"17")="@" ;alb/sat 658
. S SDECFDA(2.98,SDECIENS,"19")=$$NULLDEL(DUZ) ;data entry clerk
. S SDECFDA(2.98,SDECIENS,"20")=$$NOW^XLFDT
. S SDECFDA(2.98,SDECIENS,"21")="@" ;outpatient encounter ;*zeb 722 2/26/19 clear to fix OE link issue if cancelled again
. S SDECFDA(2.98,SDECIENS,"25")=$$NULLDEL(SDSRT) ;scheduling request type
. S SDECFDA(2.98,SDECIENS,"26")=$$NULLDEL(SDNA) ;next ava. appt. indicator
. S SDECFDA(2.98,SDECIENS,"27")=$$NULLDEL(BSDR("DDT")) ;desired date of appt
. S SDECFDA(2.98,SDECIENS,"28")=$$NULLDEL(SDFU) ;follow-up visit yes/no
. D FILE^DIE("","SDECFDA","SDECMSG") ;ICR #7030 wtc 715 5/30/2019
. N SDECTEMP S SDECTEMP=$$NULLDEL($G(SDECMSG))
E D I $G(SDECERR(1)) Q 1_U_"FileMan add to DPT error: Patient="_BSDR("PAT")_" Appt="_BSDR("ADT")
. ; add appt to file 2
. N SDECFDA,SDECIENS,SDECMSG
. S SDECIENS="?+2,"_BSDR("PAT")_","
. S SDECIENS(2)=BSDR("ADT")
. S SDECFDA(2.98,SDECIENS,.01)=BSDR("CLN")
. S SDECFDA(2.98,SDECIENS,"3")=$S($G(^DPT(+$G(BSDR("PAT")),.1))'="":"I",1:"")
. S SDECFDA(2.98,SDECIENS,"5")=BSDR("LAB") ;lab date/time
. S SDECFDA(2.98,SDECIENS,"6")=BSDR("XRA") ;xray date/time
. S SDECFDA(2.98,SDECIENS,"7")=BSDR("EKG") ;ekg date/time
. S SDECFDA(2.98,SDECIENS,"9")=BSDR("TYP")
. S:+BSDR("APT") SDECFDA(2.98,SDECIENS,"9.5")=BSDR("APT")
. S:+BSDR("COL") SDECFDA(2.98,SDECIENS,"13")=BSDR("COL")
. S SDECFDA(2.98,SDECIENS,"14")=""
. S SDECFDA(2.98,SDECIENS,"15")=""
. S SDECFDA(2.98,SDECIENS,"16")=""
. S SDECFDA(2.98,SDECIENS,"17")="" ;alb/sat 658
. S SDECFDA(2.98,SDECIENS,"19")=DUZ ;data entry clerk
. S SDECFDA(2.98,SDECIENS,"20")=$$NOW^XLFDT
. S SDECFDA(2.98,SDECIENS,"25")=SDSRT ;scheduling request type
. S SDECFDA(2.98,SDECIENS,"26")=SDNA ;next ava. appt. indicator
. S SDECFDA(2.98,SDECIENS,"27")=BSDR("DDT") ;desired date of appt
. S SDECFDA(2.98,SDECIENS,"28")=SDFU ;follow-up visit yes/no
. D UPDATE^DIE("","SDECFDA","SDECIENS","SDECERR(1)") ;ICR #7030 wtc 715 5/30/2019
;
; add appt to file 44
K DIC,DA,X,Y,DLAYGO,DD,DO
I '$D(^SC(BSDR("CLN"),"S",0)) S ^SC(BSDR("CLN"),"S",0)="^44.001DA^^"
I '$D(^SC(BSDR("CLN"),"S",BSDR("ADT"),0)) S ^SC(BSDR("CLN"),"S",BSDR("ADT"),0)=BSDR("ADT"),^(1,0)="^44.003PA^^" ; replaced call to FileMan below - 715 wtc 4/5/19
;
; Disabled code below because very occassionally it is failing. wtc 715 4/5/19
;
;I '$D(^SC(BSDR("CLN"),"S",BSDR("ADT"),0)) D I Y<1 Q 1_U_"Error adding date to file 44: Clinic="_BSDR("CLN")_" Date="_BSDR("ADT")
;. S DIC="^SC("_BSDR("CLN")_",""S"",",DA(1)=BSDR("CLN"),(X,DINUM)=BSDR("ADT")
;. S DIC("P")="44.001DA",DIC(0)="L",DLAYGO=44.001
;. S Y=1 I '$D(@(DIC_X_")")) D FILE^DICN
;
K DIC,DA,X,Y,DLAYGO,DD,DO,DINUM
S DIC="^SC("_BSDR("CLN")_",""S"","_BSDR("ADT")_",1,"
S DA(2)=BSDR("CLN"),DA(1)=BSDR("ADT"),X=BSDR("PAT")
S DIC("DR")="1////"_BSDR("LEN")_";3///"_$E($G(BSDR("OI")),1,150)_";7////"_BSDR("USR")_";8////"_$$NOW^XLFDT_";30////"_BSDR("ELG")_$S(+$G(BSDR("OVB")):";9////O",1:"")
S DIC("P")="44.003PA",DIC(0)="L",DLAYGO=44.003
D FILE^DICN
;add consult link
I $G(BSDR("CON")) D
.N SDFDA,SDIEN
.S SDIEN=+Y
.Q:SDIEN=-1
.S SDFDA(44.003,SDIEN_","_BSDR("ADT")_","_BSDR("CLN")_",",688)=BSDR("CON")
.D UPDATE^DIE("","SDFDA")
;
; removed quit so event driver could be called pwc 2/26/20 SD*5.3*744
; call event driver
NEW DFN,SDT,SDCL,SDDA,SDMODE
S DFN=BSDR("PAT"),SDT=BSDR("ADT"),SDCL=BSDR("CLN"),SDMODE=2
S SDDA=$$SCIEN^SDECU2(BSDR("PAT"),BSDR("CLN"),BSDR("ADT"))
D MAKE^SDAMEVT(DFN,SDT,SDCL,SDDA,SDMODE)
Q 0
;
NULLDEL(STR) ;return "@" to delete a field if the new data would be null ;*zeb+tag 722 2/19/19 added to support APPADD
Q $S(STR]"":STR,1:"@")
;
SDSRT(TYP,MTR,DDT,REQ) ;get SCHEDULING REQUEST TYPE and NEXT AVA.APPT. INDICATOR
;INPUT:
; TYP = 3 for scheduled appts, 4 for walkins
; MTR = MTRC flag (multiple appointments) 0=False (default) 1=True
; DDT = Desired Date of Appt in fm format
; REQ = Requested By - valid values are 1=PROVIDER 2=PATIENT or ""
;RETURN: 2 ^ pieces:
; 1 - SCHEDULING REQUEST TYPE internal format - valid values:
; N:'NEXT AVAILABLE' APPT.
; C:OTHER THAN 'NEXT AVA.' (CLINICIAN REQ.)
; P:OTHER THAN 'NEXT AVA.' (PATIENT REQ.)
; W:WALKIN APPT.
; M:MULTIPLE APPT. BOOKING
; A:AUTO REBOOK
; O:OTHER THAN 'NEXT AVA.' APPT.
; 2 - NEXT AVA. APPT. INDICATOR internal format - valid values:
; N:'NEXT AVAILABLE' APPT.
; C:OTHER THAN 'NEXT AVA.' (CLINICIAN REQ.)
; P:OTHER THAN 'NEXT AVA.' (PATIENT REQ.)
; W:WALKIN APPT.
; M:MULTIPLE APPT. BOOKING
; A:AUTO REBOOK
; O:OTHER THAN 'NEXT AVA.' APPT.
;
N RET
S RET=""
;1. If user creates a walkin appointment would be W:WALKIN APPT, 0:NOT INDICATED TO BE A 'NEXT AVA.' APPT
I TYP=4 Q "W^0"
;2. If user creates an rm request with MTRC flagged
; AND desired date is 'today'
; would be M:MULTIPLE APPT. BOOKING, 3:'NEXT AVA.' APPT. INDICATED BY USER & CALCULATION
I +MTR,$P($$NOW^XLFDT,".",1)=DDT Q "M^3"
;3. If user creates an rm request with MTRC flagged
; AND desired date is not 'today'
; would be M:MULTIPLE APPT. BOOKING, 0:'NOT INDICATED TO BE A 'NEXT AVA.' APPT
I +MTR,$P($$NOW^XLFDT,".",1)'=DDT Q "M^0"
;4. If the user enters a desired date for the clinic stop that is today
; then N:'NEXT AVAILABLE' APPT., 1:'NEXT AVA.' APPT. INDICATED BY USER
I $P($$NOW^XLFDT(),".",1)=DDT Q "N^1"
;5. If the user enters a desired date not today
; AND the request is by patient
; then P:OTHER THAN 'NEXT AVA.' (PATIENT REQ.); 0:NOT INDICATED TO BE A 'NEXT AVA.' APPT.
I $P($$NOW^XLFDT(),".",1)'=DDT,REQ=2 Q "P^0"
;6. If the user enters a desired date not today
; AND the request is by provider
; then C:OTHER THAN 'NEXT AVA.' (CLINICIAN REQ.); 0:NOT INDICATED TO BE A 'NEXT AVA.' APPT.
I $P($$NOW^XLFDT(),".",1)'=DDT,REQ=1 Q "C^0"
Q RET
;
;Create Appointment ;alb/sat 665 moved from SDEC07
APPVISTA(SDECLEN,SDECNOTE,DFN,SDECRESD,SDECSTART,SDECWKIN,SDCL,SDECI) ;
N SDECC,SDECERR,SDECRNOD
S SDECRNOD=$G(^SDEC(409.831,SDECRESD,0))
I SDECRNOD="" D ERR^SDEC07(SDECI+1,"SDEC07 Error: Unable to add appointment -- invalid Resource entry.") Q 1
S SDECERR=""
I +SDCL,$D(^SC(SDCL,0)) D I +SDECERR D ERR^SDEC07(SDECI+1,SDECERR) Q SDECERR
. S SDECC("PAT")=DFN
. S SDECC("CLN")=SDCL
. S SDECC("TYP")=3 ;3 for scheduled appts, 4 for walkins
. S:SDECWKIN SDECC("TYP")=4
. S SDECC("ADT")=SDECSTART
. S SDECC("LEN")=SDECLEN
. S SDECC("OI")=$E($G(SDECNOTE),1,150) ;File 44 has 150 character limit on OTHER field
. S SDECC("OI")=$TR(SDECC("OI"),";"," ") ;No semicolons allowed
. S SDECC("OI")=$$STRIP^SDEC07(SDECC("OI")) ;Strip control characters from note
. S SDECC("RES")=SDECRESD
. S SDECC("USR")=DUZ
. S SDECERR=$$MAKE^SDEC07B(.SDECC)
. Q:SDECERR
. D AVUPDT^SDEC07C(SDCL,SDECSTART,SDECLEN) ; Code moved from SDEC07 to SDEC07C - 715 WTC 3/26/2019
Q +SDECERR
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDEC07B 11279 printed Apr 09, 2024@21:46:21 Page 2
SDEC07B ;ALB/SAT,PC - VISTA SCHEDULING RPCS ;Feb 27, 2020@14:33
+1 ;;5.3;Scheduling;**627,658,665,669,717,722,744,694**;Aug 13, 1993;Build 61
+2 ;;Per VHA Directive 2004-038, this routine should not be modified
+3 ;
+4 QUIT
+5 ;
MAKE(BSDR) ;PEP; call to store appt made
+1 ;
+2 ; Make call using: S ERR=$$MAKE^SDEC07B(.ARRAY)
+3 ;
+4 ; Input Array -
+5 ; BSDR("PAT") = ien of patient in file 2
+6 ; BSDR("CLN") = ien of clinic in file 44
+7 ; BSDR("TYP") = C&P if appointment type is C&P, 3 for scheduled appts, 4 for walkins
+8 ; BSDR("COL") = collateral if appointment type is COLLATERAL OF VET.
+9 ; BSDR("APT") = Appointment type pointer to APPOINTMENT TYPE file 409.1
+10 ; BSDR("ADT") = appointment date and time
+11 ; BSDR("LEN") = appointment length in minutes (5-120)
+12 ; BSDR("OI") = reason for appt - up to 150 characters
+13 ; BSDR("USR") = user who made appt
+14 ; BSDR("RES") = resource pointer to SDEC RESOURCE ^SDEC(409.831,
+15 ; BSDR("MTR") = MTRC flag (multiple appointments) 0=False (default) 1=True
+16 ; BSDR("DDT") = Desired Date of Appt in fm format
+17 ; BSDR("REQ") = Requested By - valid values are 1=PROVIDER 2=PATIENT or ""
+18 ; BSDR("LAB") = LAB date/time in fm format
+19 ; BSDR("EKG") = EKG date/time in fm format
+20 ; BSDR("XRA") = XRAY date/time in fm format
+21 ; BSDR("CON") = Consult link - pointer to file 123
+22 ; BSDR("OVB") = overbook flag - 1=yes, this is an overbook
+23 ; BSDR("ELG") = Patient Eligibilty
+24 ;
+25 ;Output: error status and message
+26 ; = 0 or null: everything okay
+27 ; = 1^message: error and reason
+28 ;
+29 IF '$DATA(^DPT(+$GET(BSDR("PAT")),0))
QUIT 1_U_"Patient not on file: "_$GET(BSDR("PAT"))
+30 IF '$DATA(^SC(+$GET(BSDR("CLN")),0))
QUIT 1_U_"Clinic not on file: "_$GET(BSDR("CLN"))
+31 IF "1234"'[$GET(BSDR("TYP"))
QUIT 1_U_"Appt Type error: "_$GET(BSDR("TYP"))
+32 ;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"))
+33 ;
+34 IF ($GET(BSDR("LEN"))<5)!($GET(BSDR("LEN"))>240)
QUIT 1_U_"Appt Length error: "_$GET(BSDR("LEN"))
+35 IF '$DATA(^VA(200,+$GET(BSDR("USR")),0))
QUIT 1_U_"User Who Made Appt Error: "_$GET(BSDR("USR"))
+36 ; ICR #10035 wtc 715 5/30/2019
+37 IF $DATA(^DPT(BSDR("PAT"),"S",BSDR("ADT"),0))
IF $PIECE(^DPT(BSDR("PAT"),"S",BSDR("ADT"),0),U,2)'="C"
IF $PIECE(^DPT(BSDR("PAT"),"S",BSDR("ADT"),0),U,2)'="PC"
QUIT 1_U_"Patient "_$$GET1^DIQ(2,BSDR("PAT")_",",.01)_" already has appt at "_$$FMTE^XLFDT(BSDR("ADT"))
+38 ;
+39 NEW DIC,DA,Y,X,DD,DO,DLAYGO
+40 NEW SDECERR
+41 NEW SDFU,SDNA,SDRET,SDSRT
+42 ;
+43 SET BSDR("APT")=+$GET(BSDR("APT"))
+44 SET BSDR("COL")=+$GET(BSDR("COL"))
+45 ;get scheduling request type AND next ava. appt. indicator
+46 SET SDSRT=$$SDSRT(BSDR("TYP"),BSDR("MTR"),BSDR("DDT"),BSDR("REQ"))
+47 ; next ava.appt. indicator field 26
+48 SET SDNA=$PIECE(SDSRT,U,2)
+49 ; scheduling request type field 25
+50 SET SDSRT=$PIECE(SDSRT,U,1)
+51 ;determine if Follow-up visit field 28
+52 SET SDRET=""
+53 DO PCSTGET^SDEC(.SDRET,BSDR("PAT"),BSDR("CLN"))
+54 SET SDFU=$PIECE($PIECE(@SDRET@(1),U,2),$CHAR(30,31),1)
+55 SET SDFU=$SELECT(SDFU="YES":1,1:0)
+56 KILL @SDRET
+57 ;store
+58 ; 722/717 wtc 3/26/2019
NEW SDECCOND
+59 ; ICR #10035 wtc 715 5/30/2019
SET SDECCOND=0
IF $DATA(^DPT(BSDR("PAT"),"S",BSDR("ADT"),0))
IF (($PIECE(^DPT(BSDR("PAT"),"S",BSDR("ADT"),0),U,2)="C")!($PIECE(^DPT(BSDR("PAT"),"S",BSDR("ADT"),0),U,2)="PC"))
SET SDECCOND=1
+60 IF SDECCOND=1
Begin DoDot:1
+61 ; "un-cancel" existing appt in file 2
+62 NEW SDECFDA,SDECIENS,SDECMSG
+63 SET SDECIENS=BSDR("ADT")_","_BSDR("PAT")_","
+64 ;*zeb+19 722 2/19/19 completely replace old appt's data if overlaying; prevent chimera appt
SET SDECFDA(2.98,SDECIENS,".01")=$$NULLDEL(BSDR("CLN"))
+65 SET SDECFDA(2.98,SDECIENS,"3")=$$NULLDEL($SELECT($GET(^DPT(+$GET(BSDR("PAT")),.1))'="":"I",1:""))
+66 ;lab date/time
SET SDECFDA(2.98,SDECIENS,"5")=$$NULLDEL(BSDR("LAB"))
+67 ;xray date/time
SET SDECFDA(2.98,SDECIENS,"6")=$$NULLDEL(BSDR("XRA"))
+68 ;ekg date/time
SET SDECFDA(2.98,SDECIENS,"7")=$$NULLDEL(BSDR("EKG"))
+69 SET SDECFDA(2.98,SDECIENS,"9")=$$NULLDEL(BSDR("TYP"))
+70 SET SDECFDA(2.98,SDECIENS,"9.5")=$$NULLDEL(BSDR("APT"))
+71 SET SDECFDA(2.98,SDECIENS,"13")=$$NULLDEL(BSDR("COL"))
+72 SET SDECFDA(2.98,SDECIENS,"14")="@"
+73 SET SDECFDA(2.98,SDECIENS,"15")="@"
+74 SET SDECFDA(2.98,SDECIENS,"16")="@"
+75 ;alb/sat 658
SET SDECFDA(2.98,SDECIENS,"17")="@"
+76 ;data entry clerk
SET SDECFDA(2.98,SDECIENS,"19")=$$NULLDEL(DUZ)
+77 SET SDECFDA(2.98,SDECIENS,"20")=$$NOW^XLFDT
+78 ;outpatient encounter ;*zeb 722 2/26/19 clear to fix OE link issue if cancelled again
SET SDECFDA(2.98,SDECIENS,"21")="@"
+79 ;scheduling request type
SET SDECFDA(2.98,SDECIENS,"25")=$$NULLDEL(SDSRT)
+80 ;next ava. appt. indicator
SET SDECFDA(2.98,SDECIENS,"26")=$$NULLDEL(SDNA)
+81 ;desired date of appt
SET SDECFDA(2.98,SDECIENS,"27")=$$NULLDEL(BSDR("DDT"))
+82 ;follow-up visit yes/no
SET SDECFDA(2.98,SDECIENS,"28")=$$NULLDEL(SDFU)
+83 ;ICR #7030 wtc 715 5/30/2019
DO FILE^DIE("","SDECFDA","SDECMSG")
+84 NEW SDECTEMP
SET SDECTEMP=$$NULLDEL($GET(SDECMSG))
End DoDot:1
+85 IF '$TEST
Begin DoDot:1
+86 ; add appt to file 2
+87 NEW SDECFDA,SDECIENS,SDECMSG
+88 SET SDECIENS="?+2,"_BSDR("PAT")_","
+89 SET SDECIENS(2)=BSDR("ADT")
+90 SET SDECFDA(2.98,SDECIENS,.01)=BSDR("CLN")
+91 SET SDECFDA(2.98,SDECIENS,"3")=$SELECT($GET(^DPT(+$GET(BSDR("PAT")),.1))'="":"I",1:"")
+92 ;lab date/time
SET SDECFDA(2.98,SDECIENS,"5")=BSDR("LAB")
+93 ;xray date/time
SET SDECFDA(2.98,SDECIENS,"6")=BSDR("XRA")
+94 ;ekg date/time
SET SDECFDA(2.98,SDECIENS,"7")=BSDR("EKG")
+95 SET SDECFDA(2.98,SDECIENS,"9")=BSDR("TYP")
+96 if +BSDR("APT")
SET SDECFDA(2.98,SDECIENS,"9.5")=BSDR("APT")
+97 if +BSDR("COL")
SET SDECFDA(2.98,SDECIENS,"13")=BSDR("COL")
+98 SET SDECFDA(2.98,SDECIENS,"14")=""
+99 SET SDECFDA(2.98,SDECIENS,"15")=""
+100 SET SDECFDA(2.98,SDECIENS,"16")=""
+101 ;alb/sat 658
SET SDECFDA(2.98,SDECIENS,"17")=""
+102 ;data entry clerk
SET SDECFDA(2.98,SDECIENS,"19")=DUZ
+103 SET SDECFDA(2.98,SDECIENS,"20")=$$NOW^XLFDT
+104 ;scheduling request type
SET SDECFDA(2.98,SDECIENS,"25")=SDSRT
+105 ;next ava. appt. indicator
SET SDECFDA(2.98,SDECIENS,"26")=SDNA
+106 ;desired date of appt
SET SDECFDA(2.98,SDECIENS,"27")=BSDR("DDT")
+107 ;follow-up visit yes/no
SET SDECFDA(2.98,SDECIENS,"28")=SDFU
+108 ;ICR #7030 wtc 715 5/30/2019
DO UPDATE^DIE("","SDECFDA","SDECIENS","SDECERR(1)")
End DoDot:1
IF $GET(SDECERR(1))
QUIT 1_U_"FileMan add to DPT error: Patient="_BSDR("PAT")_" Appt="_BSDR("ADT")
+109 ;
+110 ; add appt to file 44
+111 KILL DIC,DA,X,Y,DLAYGO,DD,DO
+112 IF '$DATA(^SC(BSDR("CLN"),"S",0))
SET ^SC(BSDR("CLN"),"S",0)="^44.001DA^^"
+113 ; replaced call to FileMan below - 715 wtc 4/5/19
IF '$DATA(^SC(BSDR("CLN"),"S",BSDR("ADT"),0))
SET ^SC(BSDR("CLN"),"S",BSDR("ADT"),0)=BSDR("ADT")
SET ^(1,0)="^44.003PA^^"
+114 ;
+115 ; Disabled code below because very occassionally it is failing. wtc 715 4/5/19
+116 ;
+117 ;I '$D(^SC(BSDR("CLN"),"S",BSDR("ADT"),0)) D I Y<1 Q 1_U_"Error adding date to file 44: Clinic="_BSDR("CLN")_" Date="_BSDR("ADT")
+118 ;. S DIC="^SC("_BSDR("CLN")_",""S"",",DA(1)=BSDR("CLN"),(X,DINUM)=BSDR("ADT")
+119 ;. S DIC("P")="44.001DA",DIC(0)="L",DLAYGO=44.001
+120 ;. S Y=1 I '$D(@(DIC_X_")")) D FILE^DICN
+121 ;
+122 KILL DIC,DA,X,Y,DLAYGO,DD,DO,DINUM
+123 SET DIC="^SC("_BSDR("CLN")_",""S"","_BSDR("ADT")_",1,"
+124 SET DA(2)=BSDR("CLN")
SET DA(1)=BSDR("ADT")
SET X=BSDR("PAT")
+125 SET DIC("DR")="1////"_BSDR("LEN")_";3///"_$EXTRACT($GET(BSDR("OI")),1,150)_";7////"_BSDR("USR")_";8////"_$$NOW^XLFDT_";30////"_BSDR("ELG")_$SELECT(+$GET(BSDR("OVB")):";9////O",1:"")
+126 SET DIC("P")="44.003PA"
SET DIC(0)="L"
SET DLAYGO=44.003
+127 DO FILE^DICN
+128 ;add consult link
+129 IF $GET(BSDR("CON"))
Begin DoDot:1
+130 NEW SDFDA,SDIEN
+131 SET SDIEN=+Y
+132 if SDIEN=-1
QUIT
+133 SET SDFDA(44.003,SDIEN_","_BSDR("ADT")_","_BSDR("CLN")_",",688)=BSDR("CON")
+134 DO UPDATE^DIE("","SDFDA")
End DoDot:1
+135 ;
+136 ; removed quit so event driver could be called pwc 2/26/20 SD*5.3*744
+137 ; call event driver
+138 NEW DFN,SDT,SDCL,SDDA,SDMODE
+139 SET DFN=BSDR("PAT")
SET SDT=BSDR("ADT")
SET SDCL=BSDR("CLN")
SET SDMODE=2
+140 SET SDDA=$$SCIEN^SDECU2(BSDR("PAT"),BSDR("CLN"),BSDR("ADT"))
+141 DO MAKE^SDAMEVT(DFN,SDT,SDCL,SDDA,SDMODE)
+142 QUIT 0
+143 ;
NULLDEL(STR) ;return "@" to delete a field if the new data would be null ;*zeb+tag 722 2/19/19 added to support APPADD
+1 QUIT $SELECT(STR]"":STR,1:"@")
+2 ;
SDSRT(TYP,MTR,DDT,REQ) ;get SCHEDULING REQUEST TYPE and NEXT AVA.APPT. INDICATOR
+1 ;INPUT:
+2 ; TYP = 3 for scheduled appts, 4 for walkins
+3 ; MTR = MTRC flag (multiple appointments) 0=False (default) 1=True
+4 ; DDT = Desired Date of Appt in fm format
+5 ; REQ = Requested By - valid values are 1=PROVIDER 2=PATIENT or ""
+6 ;RETURN: 2 ^ pieces:
+7 ; 1 - SCHEDULING REQUEST TYPE internal format - valid values:
+8 ; N:'NEXT AVAILABLE' APPT.
+9 ; C:OTHER THAN 'NEXT AVA.' (CLINICIAN REQ.)
+10 ; P:OTHER THAN 'NEXT AVA.' (PATIENT REQ.)
+11 ; W:WALKIN APPT.
+12 ; M:MULTIPLE APPT. BOOKING
+13 ; A:AUTO REBOOK
+14 ; O:OTHER THAN 'NEXT AVA.' APPT.
+15 ; 2 - NEXT AVA. APPT. INDICATOR internal format - valid values:
+16 ; N:'NEXT AVAILABLE' APPT.
+17 ; C:OTHER THAN 'NEXT AVA.' (CLINICIAN REQ.)
+18 ; P:OTHER THAN 'NEXT AVA.' (PATIENT REQ.)
+19 ; W:WALKIN APPT.
+20 ; M:MULTIPLE APPT. BOOKING
+21 ; A:AUTO REBOOK
+22 ; O:OTHER THAN 'NEXT AVA.' APPT.
+23 ;
+24 NEW RET
+25 SET RET=""
+26 ;1. If user creates a walkin appointment would be W:WALKIN APPT, 0:NOT INDICATED TO BE A 'NEXT AVA.' APPT
+27 IF TYP=4
QUIT "W^0"
+28 ;2. If user creates an rm request with MTRC flagged
+29 ; AND desired date is 'today'
+30 ; would be M:MULTIPLE APPT. BOOKING, 3:'NEXT AVA.' APPT. INDICATED BY USER & CALCULATION
+31 IF +MTR
IF $PIECE($$NOW^XLFDT,".",1)=DDT
QUIT "M^3"
+32 ;3. If user creates an rm request with MTRC flagged
+33 ; AND desired date is not 'today'
+34 ; would be M:MULTIPLE APPT. BOOKING, 0:'NOT INDICATED TO BE A 'NEXT AVA.' APPT
+35 IF +MTR
IF $PIECE($$NOW^XLFDT,".",1)'=DDT
QUIT "M^0"
+36 ;4. If the user enters a desired date for the clinic stop that is today
+37 ; then N:'NEXT AVAILABLE' APPT., 1:'NEXT AVA.' APPT. INDICATED BY USER
+38 IF $PIECE($$NOW^XLFDT(),".",1)=DDT
QUIT "N^1"
+39 ;5. If the user enters a desired date not today
+40 ; AND the request is by patient
+41 ; then P:OTHER THAN 'NEXT AVA.' (PATIENT REQ.); 0:NOT INDICATED TO BE A 'NEXT AVA.' APPT.
+42 IF $PIECE($$NOW^XLFDT(),".",1)'=DDT
IF REQ=2
QUIT "P^0"
+43 ;6. If the user enters a desired date not today
+44 ; AND the request is by provider
+45 ; then C:OTHER THAN 'NEXT AVA.' (CLINICIAN REQ.); 0:NOT INDICATED TO BE A 'NEXT AVA.' APPT.
+46 IF $PIECE($$NOW^XLFDT(),".",1)'=DDT
IF REQ=1
QUIT "C^0"
+47 QUIT RET
+48 ;
+49 ;Create Appointment ;alb/sat 665 moved from SDEC07
APPVISTA(SDECLEN,SDECNOTE,DFN,SDECRESD,SDECSTART,SDECWKIN,SDCL,SDECI) ;
+1 NEW SDECC,SDECERR,SDECRNOD
+2 SET SDECRNOD=$GET(^SDEC(409.831,SDECRESD,0))
+3 IF SDECRNOD=""
DO ERR^SDEC07(SDECI+1,"SDEC07 Error: Unable to add appointment -- invalid Resource entry.")
QUIT 1
+4 SET SDECERR=""
+5 IF +SDCL
IF $DATA(^SC(SDCL,0))
Begin DoDot:1
+6 SET SDECC("PAT")=DFN
+7 SET SDECC("CLN")=SDCL
+8 ;3 for scheduled appts, 4 for walkins
SET SDECC("TYP")=3
+9 if SDECWKIN
SET SDECC("TYP")=4
+10 SET SDECC("ADT")=SDECSTART
+11 SET SDECC("LEN")=SDECLEN
+12 ;File 44 has 150 character limit on OTHER field
SET SDECC("OI")=$EXTRACT($GET(SDECNOTE),1,150)
+13 ;No semicolons allowed
SET SDECC("OI")=$TRANSLATE(SDECC("OI"),";"," ")
+14 ;Strip control characters from note
SET SDECC("OI")=$$STRIP^SDEC07(SDECC("OI"))
+15 SET SDECC("RES")=SDECRESD
+16 SET SDECC("USR")=DUZ
+17 SET SDECERR=$$MAKE^SDEC07B(.SDECC)
+18 if SDECERR
QUIT
+19 ; Code moved from SDEC07 to SDEC07C - 715 WTC 3/26/2019
DO AVUPDT^SDEC07C(SDCL,SDECSTART,SDECLEN)
End DoDot:1
IF +SDECERR
DO ERR^SDEC07(SDECI+1,SDECERR)
QUIT SDECERR
+20 QUIT +SDECERR
+21 ;
