SDESCREATEAPPT2 ;ALB/BLB,MGD,DJS - VISTA SCHEDULING RPCS ;Oct 7, 2022
;;5.3;Scheduling;**814,823,826,827**;Aug 13, 1993;Build 10
;;Per VHA Directive 6402, this routine should not be modified
;
Q
;
; appt in file 2. Called from wrapper level SDESCRTAPPTWRAP. See SDESCRTAPPTWRAP for required inputs.
;
;
VALIDATE(ERRORS,ARY2) ; Validate
; patient DFN
S ARY2("DFN")=$G(ARY2("DFN"),"")
I ARY2("DFN")="" D ERRLOG^SDESJSON(.ERRORS,1) Q
I ARY2("DFN")'="",'$D(^DPT(+ARY2("DFN"),0)) D ERRLOG^SDESJSON(.ERRORS,2) Q
;
; clinic IEN
S ARY2("CLINICIEN")=$G(ARY2("CLINICIEN"),"")
I ARY2("CLINICIEN")="" D ERRLOG^SDESJSON(.ERRORS,18) Q
I '$D(^SC(+ARY2("CLINICIEN"),0)) D ERRLOG^SDESJSON(.ERRORS,19) Q
I $$INACTIVE^SDEC32(+ARY2("CLINICIEN")) D ERRLOG^SDESJSON(.ERRORS,19) Q
;
; appointment Type
S ARY2("SDAPPTYPE")=$G(ARY2("SDAPPTYPE"),"")
S ARY2("SDAPPTNAME")=$G(ARY2("SDAPPTNAME"),"")
I ARY2("SDAPPTYPE")="",ARY2("SDAPPTNAME")="" D ERRLOG^SDESJSON(.ERRORS,306)
N APPTTYPIEN,IENNOTVALID,NAMENOTVALID
S (APPTTYPIEN,IENNOTVALID,NAMENOTVALID)=0
I ARY2("SDAPPTNAME")'="" D
. S APPTTYPIEN=$$FIND1^DIC(409.1,"","X",ARY2("SDAPPTNAME"),"B")
. I 'APPTTYPIEN S NAMENOTVALID=1 Q
. I APPTTYPIEN,('$D(^SD(409.1,APPTTYPIEN,0))) S NAMENOTVALID=1
I $L(ARY2("SDAPPTYPE")),'ARY2("SDAPPTYPE") D
. S ARY2("SDAPPTYPE")=$O(^SD(409.1,"B",ARY2("SDAPPTYPE"),0))
. I 'ARY2("SDAPPTYPE") S NAMENOTVALID=1
I ARY2("SDAPPTYPE"),('$D(^SD(409.1,ARY2("SDAPPTYPE"),0))) S IENNOTVALID=1
I IENNOTVALID,NAMENOTVALID D ERRLOG^SDESJSON(.ERRORS,61)
I APPTTYPIEN S ARY2("SDAPPTYPE")=APPTTYPIEN
I 'ARY2("SDAPPTYPE") D ERRLOG^SDESJSON(.ERRORS,61)
;
; appointment date/time
S ARY2("SDAPPTSTARTDTTM")=$G(ARY2("SDAPPTSTARTDTTM"),"")
I ARY2("SDAPPTSTARTDTTM")="" D ERRLOG^SDESJSON(.ERRORS,76) Q
S ARY2("SDAPPTSTARTDTTM")=$$ISOTFM^SDAMUTDT(ARY2("SDAPPTSTARTDTTM"),ARY2("CLINICIEN"))
I ARY2("SDAPPTSTARTDTTM")=-1 S ARY2("SDAPPTSTARTDTTM")="" D ERRLOG^SDESJSON(.ERRORS,77) Q
;I ARY2("SDAPPTSTARTDTTM")<DT D ERRLOG^SDESJSON(.ERRORS,59) Q ;Allow Appointments made in the Past
;
; lab date/time
S ARY2("SDLABDTTM")=$G(ARY2("SDLABDTTM"),"")
I ARY2("SDLABDTTM")'="" S ARY2("SDLABDTTM")=$$ISOTFM^SDAMUTDT(ARY2("SDLABDTTM"),ARY2("CLINICIEN"))
I ARY2("SDLABDTTM")=-1 S ARY2("SDLABDTTM")="" D ERRLOG^SDESJSON(.ERRORS,147) Q
;
; xray date/time
S ARY2("SDXRAYDTTM")=$G(ARY2("SDXRAYDTTM"),"")
I ARY2("SDXRAYDTTM")'="" S ARY2("SDXRAYDTTM")=$$ISOTFM^SDAMUTDT(ARY2("SDXRAYDTTM"),ARY2("CLINICIEN"))
I ARY2("SDXRAYDTTM")=-1 D ERRLOG^SDESJSON(.ERRORS,145) Q
;
; ekg date/time
S ARY2("SDEKGDTTM")=$G(ARY2("SDEKGDTTM"),"")
I ARY2("SDEKGDTTM")'="" S ARY2("SDEKGDTTM")=$$ISOTFM^SDAMUTDT(ARY2("SDEKGDTTM"),ARY2("CLINICIEN"))
I ARY2("SDEKGDTTM")=-1 D ERRLOG^SDESJSON(.ERRORS,146) Q
;
; purpose of visit
S ARY2("SDPURPOSE")=$G(ARY2("SDPURPOSE"),"")
S ARY2("SDPURPOSE")=$E(ARY2("SDPURPOSE"),1,1)
I ARY2("SDPURPOSE")="" D ERRLOG^SDESJSON(.ERRORS,149) Q
I "1234"'[+ARY2("SDPURPOSE") D ERRLOG^SDESJSON(.ERRORS,148) Q
;
; collateral visit
S ARY2("SDCOLLATERAL")=$G(ARY2("SDCOLLATERAL"),"")
S ARY2("SDCOLLATERAL")=$E(ARY2("SDCOLLATERAL"),1,1)
I ARY2("SDCOLLATERAL")'="",("01"'[ARY2("SDCOLLATERAL")) D ERRLOG^SDESJSON(.ERRORS,150) Q
;
; scheduling request type
S ARY2("SDSCHREQTYPE")=$G(ARY2("SDSCHREQTYPE"),"")
S ARY2("SDSCHREQTYPE")=$E(ARY2("SDSCHREQTYPE"),1,1)
I ARY2("SDSCHREQTYPE")="" D ERRLOG^SDESJSON(.ERRORS,151) Q
I ("NCPWMAO"'[ARY2("SDSCHREQTYPE")) D ERRLOG^SDESJSON(.ERRORS,152) Q
;
; next available appointment indicator
S ARY2("SDNXTAVAAPPT")=$G(ARY2("SDNXTAVAAPPT"),"")
S ARY2("SDNXTAVAAPPT")=$E(ARY2("SDNXTAVAAPPT"),1,1)
I ARY2("SDNXTAVAAPPT")="" D ERRLOG^SDESJSON(.ERRORS,154) Q
I ("0123"'[ARY2("SDNXTAVAAPPT")) D ERRLOG^SDESJSON(.ERRORS,153) Q
;
; followup visit
S ARY2("SDFOLLOWUP")=$G(ARY2("SDFOLLOWUP"),"")
I ARY2("SDFOLLOWUP")'="",("01"'[ARY2("SDFOLLOWUP")) D ERRLOG^SDESJSON(.ERRORS,155) Q
;
Q
;
CREATE(ARRAY2FDA,NEWIENF2,ARY2,PID) ;
N SDECIENS
;
I $D(^DPT(ARY2("DFN"),"S",ARY2("SDAPPTSTARTDTTM"),0)) D
.D DELETECANRECORD(ARY2("DFN"),ARY2("SDAPPTSTARTDTTM"),ARY2("CLINICIEN"))
;
S NEWIENF2(1)=ARY2("SDAPPTSTARTDTTM")
S SDECIENS="+1,"_ARY2("DFN")_","
S ARRAY2FDA(2.98,SDECIENS,".01")=ARY2("CLINICIEN")
S ARRAY2FDA(2.98,SDECIENS,"3")=$S($G(^DPT(+$G(DFN),.1))'="":"I",1:"")
S ARRAY2FDA(2.98,SDECIENS,"5")=ARY2("SDLABDTTM")
S ARRAY2FDA(2.98,SDECIENS,"6")=ARY2("SDXRAYDTTM")
S ARRAY2FDA(2.98,SDECIENS,"7")=ARY2("SDEKGDTTM")
S ARRAY2FDA(2.98,SDECIENS,"9")=ARY2("SDPURPOSE")
S ARRAY2FDA(2.98,SDECIENS,"9.5")=ARY2("SDAPPTYPE")
S ARRAY2FDA(2.98,SDECIENS,"13")=ARY2("SDCOLLATERAL")
S ARRAY2FDA(2.98,SDECIENS,"19")=DUZ
S ARRAY2FDA(2.98,SDECIENS,"20")=$$NOW^XLFDT
S ARRAY2FDA(2.98,SDECIENS,"25")=ARY2("SDSCHREQTYPE")
S ARRAY2FDA(2.98,SDECIENS,"26")=ARY2("SDNXTAVAAPPT")
S ARRAY2FDA(2.98,SDECIENS,"27")=$G(PID)
S ARRAY2FDA(2.98,SDECIENS,"28")=ARY2("SDFOLLOWUP")
Q
;
DELETECANRECORD(DFN,DATETIME,CLINICIEN) ;
N SUBIEN,FOUND,FDA,FDAERR
S SUBIEN=0,FOUND=0
F S SUBIEN=$O(^SC(CLINICIEN,"S",DATETIME,1,SUBIEN)) Q:'SUBIEN!(FOUND=1) D
.I $$GET1^DIQ(44.003,SUBIEN_","_DATETIME_","_CLINICIEN_",",.01,"I")=DFN D
..I $$GET1^DIQ(44.003,SUBIEN_","_DATETIME_","_CLINICIEN_",",310)'="CANCELLED" D
...S FOUND=1
...S FDA(2.98,DATETIME_","_DFN_",",.01)="@"
...D FILE^DIE(,"FDA","FDAERR") K FDA
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDESCREATEAPPT2 5436 printed Oct 16, 2024@18:56:47 Page 2
SDESCREATEAPPT2 ;ALB/BLB,MGD,DJS - VISTA SCHEDULING RPCS ;Oct 7, 2022
+1 ;;5.3;Scheduling;**814,823,826,827**;Aug 13, 1993;Build 10
+2 ;;Per VHA Directive 6402, this routine should not be modified
+3 ;
+4 QUIT
+5 ;
+6 ; appt in file 2. Called from wrapper level SDESCRTAPPTWRAP. See SDESCRTAPPTWRAP for required inputs.
+7 ;
+8 ;
VALIDATE(ERRORS,ARY2) ; Validate
+1 ; patient DFN
+2 SET ARY2("DFN")=$GET(ARY2("DFN"),"")
+3 IF ARY2("DFN")=""
DO ERRLOG^SDESJSON(.ERRORS,1)
QUIT
+4 IF ARY2("DFN")'=""
IF '$DATA(^DPT(+ARY2("DFN"),0))
DO ERRLOG^SDESJSON(.ERRORS,2)
QUIT
+5 ;
+6 ; clinic IEN
+7 SET ARY2("CLINICIEN")=$GET(ARY2("CLINICIEN"),"")
+8 IF ARY2("CLINICIEN")=""
DO ERRLOG^SDESJSON(.ERRORS,18)
QUIT
+9 IF '$DATA(^SC(+ARY2("CLINICIEN"),0))
DO ERRLOG^SDESJSON(.ERRORS,19)
QUIT
+10 IF $$INACTIVE^SDEC32(+ARY2("CLINICIEN"))
DO ERRLOG^SDESJSON(.ERRORS,19)
QUIT
+11 ;
+12 ; appointment Type
+13 SET ARY2("SDAPPTYPE")=$GET(ARY2("SDAPPTYPE"),"")
+14 SET ARY2("SDAPPTNAME")=$GET(ARY2("SDAPPTNAME"),"")
+15 IF ARY2("SDAPPTYPE")=""
IF ARY2("SDAPPTNAME")=""
DO ERRLOG^SDESJSON(.ERRORS,306)
+16 NEW APPTTYPIEN,IENNOTVALID,NAMENOTVALID
+17 SET (APPTTYPIEN,IENNOTVALID,NAMENOTVALID)=0
+18 IF ARY2("SDAPPTNAME")'=""
Begin DoDot:1
+19 SET APPTTYPIEN=$$FIND1^DIC(409.1,"","X",ARY2("SDAPPTNAME"),"B")
+20 IF 'APPTTYPIEN
SET NAMENOTVALID=1
QUIT
+21 IF APPTTYPIEN
IF ('$DATA(^SD(409.1,APPTTYPIEN,0)))
SET NAMENOTVALID=1
End DoDot:1
+22 IF $LENGTH(ARY2("SDAPPTYPE"))
IF 'ARY2("SDAPPTYPE")
Begin DoDot:1
+23 SET ARY2("SDAPPTYPE")=$ORDER(^SD(409.1,"B",ARY2("SDAPPTYPE"),0))
+24 IF 'ARY2("SDAPPTYPE")
SET NAMENOTVALID=1
End DoDot:1
+25 IF ARY2("SDAPPTYPE")
IF ('$DATA(^SD(409.1,ARY2("SDAPPTYPE"),0)))
SET IENNOTVALID=1
+26 IF IENNOTVALID
IF NAMENOTVALID
DO ERRLOG^SDESJSON(.ERRORS,61)
+27 IF APPTTYPIEN
SET ARY2("SDAPPTYPE")=APPTTYPIEN
+28 IF 'ARY2("SDAPPTYPE")
DO ERRLOG^SDESJSON(.ERRORS,61)
+29 ;
+30 ; appointment date/time
+31 SET ARY2("SDAPPTSTARTDTTM")=$GET(ARY2("SDAPPTSTARTDTTM"),"")
+32 IF ARY2("SDAPPTSTARTDTTM")=""
DO ERRLOG^SDESJSON(.ERRORS,76)
QUIT
+33 SET ARY2("SDAPPTSTARTDTTM")=$$ISOTFM^SDAMUTDT(ARY2("SDAPPTSTARTDTTM"),ARY2("CLINICIEN"))
+34 IF ARY2("SDAPPTSTARTDTTM")=-1
SET ARY2("SDAPPTSTARTDTTM")=""
DO ERRLOG^SDESJSON(.ERRORS,77)
QUIT
+35 ;I ARY2("SDAPPTSTARTDTTM")<DT D ERRLOG^SDESJSON(.ERRORS,59) Q ;Allow Appointments made in the Past
+36 ;
+37 ; lab date/time
+38 SET ARY2("SDLABDTTM")=$GET(ARY2("SDLABDTTM"),"")
+39 IF ARY2("SDLABDTTM")'=""
SET ARY2("SDLABDTTM")=$$ISOTFM^SDAMUTDT(ARY2("SDLABDTTM"),ARY2("CLINICIEN"))
+40 IF ARY2("SDLABDTTM")=-1
SET ARY2("SDLABDTTM")=""
DO ERRLOG^SDESJSON(.ERRORS,147)
QUIT
+41 ;
+42 ; xray date/time
+43 SET ARY2("SDXRAYDTTM")=$GET(ARY2("SDXRAYDTTM"),"")
+44 IF ARY2("SDXRAYDTTM")'=""
SET ARY2("SDXRAYDTTM")=$$ISOTFM^SDAMUTDT(ARY2("SDXRAYDTTM"),ARY2("CLINICIEN"))
+45 IF ARY2("SDXRAYDTTM")=-1
DO ERRLOG^SDESJSON(.ERRORS,145)
QUIT
+46 ;
+47 ; ekg date/time
+48 SET ARY2("SDEKGDTTM")=$GET(ARY2("SDEKGDTTM"),"")
+49 IF ARY2("SDEKGDTTM")'=""
SET ARY2("SDEKGDTTM")=$$ISOTFM^SDAMUTDT(ARY2("SDEKGDTTM"),ARY2("CLINICIEN"))
+50 IF ARY2("SDEKGDTTM")=-1
DO ERRLOG^SDESJSON(.ERRORS,146)
QUIT
+51 ;
+52 ; purpose of visit
+53 SET ARY2("SDPURPOSE")=$GET(ARY2("SDPURPOSE"),"")
+54 SET ARY2("SDPURPOSE")=$EXTRACT(ARY2("SDPURPOSE"),1,1)
+55 IF ARY2("SDPURPOSE")=""
DO ERRLOG^SDESJSON(.ERRORS,149)
QUIT
+56 IF "1234"'[+ARY2("SDPURPOSE")
DO ERRLOG^SDESJSON(.ERRORS,148)
QUIT
+57 ;
+58 ; collateral visit
+59 SET ARY2("SDCOLLATERAL")=$GET(ARY2("SDCOLLATERAL"),"")
+60 SET ARY2("SDCOLLATERAL")=$EXTRACT(ARY2("SDCOLLATERAL"),1,1)
+61 IF ARY2("SDCOLLATERAL")'=""
IF ("01"'[ARY2("SDCOLLATERAL"))
DO ERRLOG^SDESJSON(.ERRORS,150)
QUIT
+62 ;
+63 ; scheduling request type
+64 SET ARY2("SDSCHREQTYPE")=$GET(ARY2("SDSCHREQTYPE"),"")
+65 SET ARY2("SDSCHREQTYPE")=$EXTRACT(ARY2("SDSCHREQTYPE"),1,1)
+66 IF ARY2("SDSCHREQTYPE")=""
DO ERRLOG^SDESJSON(.ERRORS,151)
QUIT
+67 IF ("NCPWMAO"'[ARY2("SDSCHREQTYPE"))
DO ERRLOG^SDESJSON(.ERRORS,152)
QUIT
+68 ;
+69 ; next available appointment indicator
+70 SET ARY2("SDNXTAVAAPPT")=$GET(ARY2("SDNXTAVAAPPT"),"")
+71 SET ARY2("SDNXTAVAAPPT")=$EXTRACT(ARY2("SDNXTAVAAPPT"),1,1)
+72 IF ARY2("SDNXTAVAAPPT")=""
DO ERRLOG^SDESJSON(.ERRORS,154)
QUIT
+73 IF ("0123"'[ARY2("SDNXTAVAAPPT"))
DO ERRLOG^SDESJSON(.ERRORS,153)
QUIT
+74 ;
+75 ; followup visit
+76 SET ARY2("SDFOLLOWUP")=$GET(ARY2("SDFOLLOWUP"),"")
+77 IF ARY2("SDFOLLOWUP")'=""
IF ("01"'[ARY2("SDFOLLOWUP"))
DO ERRLOG^SDESJSON(.ERRORS,155)
QUIT
+78 ;
+79 QUIT
+80 ;
CREATE(ARRAY2FDA,NEWIENF2,ARY2,PID) ;
+1 NEW SDECIENS
+2 ;
+3 IF $DATA(^DPT(ARY2("DFN"),"S",ARY2("SDAPPTSTARTDTTM"),0))
Begin DoDot:1
+4 DO DELETECANRECORD(ARY2("DFN"),ARY2("SDAPPTSTARTDTTM"),ARY2("CLINICIEN"))
End DoDot:1
+5 ;
+6 SET NEWIENF2(1)=ARY2("SDAPPTSTARTDTTM")
+7 SET SDECIENS="+1,"_ARY2("DFN")_","
+8 SET ARRAY2FDA(2.98,SDECIENS,".01")=ARY2("CLINICIEN")
+9 SET ARRAY2FDA(2.98,SDECIENS,"3")=$SELECT($GET(^DPT(+$GET(DFN),.1))'="":"I",1:"")
+10 SET ARRAY2FDA(2.98,SDECIENS,"5")=ARY2("SDLABDTTM")
+11 SET ARRAY2FDA(2.98,SDECIENS,"6")=ARY2("SDXRAYDTTM")
+12 SET ARRAY2FDA(2.98,SDECIENS,"7")=ARY2("SDEKGDTTM")
+13 SET ARRAY2FDA(2.98,SDECIENS,"9")=ARY2("SDPURPOSE")
+14 SET ARRAY2FDA(2.98,SDECIENS,"9.5")=ARY2("SDAPPTYPE")
+15 SET ARRAY2FDA(2.98,SDECIENS,"13")=ARY2("SDCOLLATERAL")
+16 SET ARRAY2FDA(2.98,SDECIENS,"19")=DUZ
+17 SET ARRAY2FDA(2.98,SDECIENS,"20")=$$NOW^XLFDT
+18 SET ARRAY2FDA(2.98,SDECIENS,"25")=ARY2("SDSCHREQTYPE")
+19 SET ARRAY2FDA(2.98,SDECIENS,"26")=ARY2("SDNXTAVAAPPT")
+20 SET ARRAY2FDA(2.98,SDECIENS,"27")=$GET(PID)
+21 SET ARRAY2FDA(2.98,SDECIENS,"28")=ARY2("SDFOLLOWUP")
+22 QUIT
+23 ;
DELETECANRECORD(DFN,DATETIME,CLINICIEN) ;
+1 NEW SUBIEN,FOUND,FDA,FDAERR
+2 SET SUBIEN=0
SET FOUND=0
+3 FOR
SET SUBIEN=$ORDER(^SC(CLINICIEN,"S",DATETIME,1,SUBIEN))
if 'SUBIEN!(FOUND=1)
QUIT
Begin DoDot:1
+4 IF $$GET1^DIQ(44.003,SUBIEN_","_DATETIME_","_CLINICIEN_",",.01,"I")=DFN
Begin DoDot:2
+5 IF $$GET1^DIQ(44.003,SUBIEN_","_DATETIME_","_CLINICIEN_",",310)'="CANCELLED"
Begin DoDot:3
+6 SET FOUND=1
+7 SET FDA(2.98,DATETIME_","_DFN_",",.01)="@"
+8 DO FILE^DIE(,"FDA","FDAERR")
KILL FDA
End DoDot:3
End DoDot:2
End DoDot:1
+9 ;
