SDESCLINICSET ;ALB/TAW,MGD,BWF,LAB,MGD,ANU,DJS - CLINIC CREATE AND UPDATE ;OCT 24, 2023
;;5.3;Scheduling;**799,805,820,824,825,831,835,836,857,860,864**;Aug 13, 1993;Build 15
;;Per VHA Directive 6402, this routine should not be modified
;
; Reference to ^DG(40.8 is supported by IA #2295
; Reference to ^DG(40.8 is supported by IA #7024
;
; SDNAME - [TEXT, REQ] Clinic Name
; SDABR - [TEXT] ABBREVIATION
; SDPATNAME - [TEXT] PATIENT FRIENDLY NAME
; SDMEETATFAC - [Y/N] CLINIC MEETS AT THIS FACILITY? (Default = Y)
; SDPATSCHED - [Y/N, REQ] ALLOW DIRECT PATIENT SCHEDULING?
; SDDISPAPPT - [Y/N, REQ] DISPLAY CLIN APPT TO PATIENTS?
; SDSERVICE - [Set of codes, REQ] SERVICE
; SDNONCOUNT - [Y/N, REQ] NON-COUNT CLINIC? (Y OR N)
; SDDIVSION - [File 40.8] DIVISION
; SDSTOPCODE - [File 40.7, REQ] STOP CODE NUMBER
; SDAPPTTYP - [File 409.1] DEFAULT APPOINTMENT TYPE
; SDINPATMED - [Y/N] ADMINISTER INPATIENT MEDS?
; SDPHONE - [TEXT] TELEPHONE
; SDREQXRAY - [Y/N] REQUIRE X-RAY FILMS?
; SDREQPROFILE - [Y/N] REQUIRE ACTION PROFILES?
; SDNOSHOWLET - [File 407.5] NO SHOW LETTER
; SDPREAPTLET - [File 407.5] PRE-APPOINTMENT LETTER
; SDCANLET - [File 407.5] CLINIC CANCELLATION LETTER
; SDAPTCANLET - [File 407.5] APPT. CANCELLATION LETTER
; SDINOUTTIME - [Y/N] ASK FOR CHECK IN/OUT TIME
; SDPROVIDER - [File 200] PROVIDER
; SDPRACTIONER - [Y/N] DEFAULT TO PC PRACTITIONER?
; SDDIAG - [file 80] DIAGNOSIS
; SDWORKLOAD - [Y/N] WORKLOAD VALIDATION AT CHK OUT
; SDALLOWNOSHW - [NUM, REQ] ALLOWABLE CONSECUTIVE NO-SHOWS
; SDMACFUTBOOK - [NUM, REQ] MAX # DAYS FOR FUTURE BOOKING
; SDSCHEDHOLIDAY - [Y/N] SCHEDULE ON HOLIDAYS?
; SDCREDITSTOP - [File 40.7] CREDIT STOP CODE
; SDNOACCESS - [Y/N] PROHIBIT ACCESS TO CLINIC?
; SDLOCATION - [TEXT] PHYSICAL LOCATION
; SDPRINCLINIC - [File 44] PRINCIPAL Clinic
; SDOVBDAYMAX - [NUM, REQ] OVERBOOKS/DAY MAXIMUM
; SDSPECINSTRU - [TEXT] SPECIAL INSTRUCTIONS
; SDECHECKIN - [Y/N] E-CHECKIN ALLOWED
; SDPRECJECKIN - [Y/N] PRE-CHECKIN ALLOWED NO
; SDLENGTHOFAPT - [NUM, REQ] LENGTH OF APP'T
; SDVARAPTLNG - [TEXT] VARIABLE APP'NTMENT LENGTH
; SDINCPERHR - [NUM, REQ] DISPLAY INCRUMENTS PER HOUR
; SDSTARTHR - [NUM] HOUR CLINIC DISPLAY BEGINS (Default = 8)
; SDEAS - [TEXT OPT] Enterprise Appointment Scheduling (EAS) Tracking Number associated to an appointment.
; HASH - [TEXT] SHA-1 Hash value that the calling app has stored
; PRIAMIS - [NUM, OPT] AMIS Primary Stop Code
; CREDITAMIS - [NUM, OPT] AMIS Credit Stop Code
;
CLINICEDIT(RET,CLINIEN,P1,P2,P3,P4,P5,P6,P7,P8,P9,P10,P11,P12,P13,P14,P15,P16,P17,P18,P19,P20,P21,P22,P23,P24,P25,P26,P27,P28,P29,P30,P31,P32,P33,P34,P35,P36,P37,P38,P39,P40,P41,P42,P43,P44) ;
S CLINIEN=$G(CLINIEN,"")
S:CLINIEN="" CLINIEN=-1 ;Flag missing ARIEN when calling the update RPC
S P1=$G(P1),P2=$G(P2),P3=$G(P3),P4=$G(P4),P5=$G(P5),P6=$G(P6),P7=$G(P7),P8=$G(P8),P9=$G(P9),P10=$G(P10),P11=$G(P11),P12=$G(P12),P13=$G(P13),P14=$G(P14),P15=$G(P15),P16=$G(P16),P17=$G(P17)
S P18=$G(P18),P19=$G(P19),P20=$G(P20),P21=$G(P21),P22=$G(P22),P23=$G(P23)
S P24=$G(P24),P25=$G(P25),P26=$G(P26),P27=$G(P27),P28=$G(P28),P29=$G(P29),P30=$G(P30),P31=$G(P31),P32=$G(P32),P33=$G(P33),P34=$G(P34),P35=$G(P35),P36=$G(P36),P37=$G(P37),P38=$G(P38),P39=$G(P39),P40=$G(P40)
S P41=$G(P41),P42=$G(P42),P43=$G(P43),P44=$G(P44)
D CLINICSET^SDESCLINICSET(.RET,CLINIEN,P1,P2,P3,P4,P5,P6,P7,P8,P9,P10,P11,P12,P13,P14,P15,P16,P17,P18,P19,P20,P21,P22,P23,P24,P25,P26,P27,P28,P29,P30,P31,P32,P33,P34,P35,P36,P37,P38,P39,P40,P41,P42,P43,P44)
Q
;
CLINICSET(RETURN,P0,P1,P2,P3,P4,P5,P6,P7,P8,P9,P10,P11,P12,P13,P14,P15,P16,P17,P18,P19,P20,P21,P22,P23,P24,P25,P26,P27,P28,P29,P30,P31,P32,P33,P34,P35,P36,P37,P38,P39,P40,P41,P42,P43,P44) ;
N SDCLINIC,SDNAME,SDABR,SDPATNAME,SDMEETATFAC,SDPATSCHED,SDDISPAPPT,SDSERVICE,SDNONCOUNT,SDDIVSION,SDSTOPCODE,SDAPPTTYP,SDIEN
N SDINPATMED,SDPHONE,SDREQXRAY,SDREQPROFILE,SDNOSHOWLET,SDPREAPTLET,SDCANLET,SDAPTCANLET,SDINOUTTIME,SDPROVIDER,SDPRACTIONER
N SDDIAG,SDWORKLOAD,SDALLOWNOSHW,SDMAXFUTBOOK,SDSTTMAUTOBOOK,SDMAXDAYREBOOK,SDSCHEDHOLIDAY,SDCREDITSTOP,SDNOACCESS,SDFHRCLINBEGIN
N SDLOCATION,SDPRINCLINIC,SDOVBDAYMAX,SDSPECINSTRU,SDECHECKIN,SDPRECHECKIN,SDLENGTHOFAPT,SDVARAPTLNG,POP,SDINCPERHR,DEFAULTNEW
N I,PROV,PROVIDER,DIAG,DIAGNOSIS,INSTRUCTION,SPECIALINSTRUCT,PROVDATA,DEFAULT,KEY,DIAGDATA,DEFAULT,DEFAULTCNT,DEFAULTFLAG,ACTION
N DEFAULTCNT2,DEFALUTREMOVE,X,PRIVUSER,PRIVLIAGEDUSER,MI,SDSTARTHR,ERR,FDA,SDEAS,PRIAMIS,CREDITAMIS,SDPHONEEXT,SDINACTIVEDATE
S POP=0
I P0="" D
.D VALIDATE(0)
.I 'POP D CREATE
I P0'="" D
.D VALIDATE(1)
.I 'POP D UPDATE
.D:('POP)&($G(P41)'="") CHECKHASH(.SDERROR,P0,P41)
I 'POP D SAVE^SDESCLINICSET2(.POP,SDIEN,.FDA,.SDCLINIC,.PROVIDER,.DIAGNOSIS,.SPECIALINSTRUCT,.PRIVLIAGEDUSER)
D BUILDER
Q
;
CHECKHASH(SDERROR,CLIN,INPUTHASH) ;
N CURHASH
S CURHASH=$$GET1^DIQ(44,CLIN,2900,"I")
D:CURHASH'=INPUTHASH ERRLOG(252)
Q
;
VALIDATE(EDIT) ;
S SDIEN=$G(P0)
I SDIEN'="" D
.; If the Update RPC is called and no SDIEN is sent then it will show as -1
.I SDIEN=-1 D ERRLOG(18) Q
.I '$D(^SC(SDIEN,0)) D ERRLOG(19)
;
S SDNAME=$G(P1)
I SDNAME="@" S SDNAME="" ;Can't remove the name
I 'EDIT,SDNAME="" D ERRLOG(50)
I SDNAME'="",$D(^SC("B",$E(SDNAME,1,30))) D ERRLOG(51,"Name already in use")
;
S SDABR=$G(P2)
I $L(SDABR)>7 D ERRLOG(251)
;
S SDPATNAME=$G(P3)
;
S SDMEETATFAC=$G(P4)
I 'EDIT,SDMEETATFAC="" S SDMEETATFAC="Y" ;Default to Y
I '$$CHECKYN(SDMEETATFAC) D ERRLOG(87)
;
S SDPATSCHED=$G(P5)
I SDPATSCHED="@" S SDPATSCHED="" ;Can't remove a required field
I 'EDIT,SDPATSCHED="" D ERRLOG(88)
I '$$CHECKYN(SDPATSCHED) D ERRLOG(89)
;
S SDDISPAPPT=$G(P6)
I SDDISPAPPT="@" S SDDISPAPPT="" ;Can't remove a required field
I 'EDIT,SDDISPAPPT="" D ERRLOG(90)
I '$$CHECKYN(SDDISPAPPT) D ERRLOG(91)
;
S SDSERVICE=$G(P7)
I SDSERVICE="@" S SDSERVICE="" ;Can't remove a required field
I 'EDIT,SDSERVICE="" D ERRLOG(92)
S SDSERVICE=$E(SDSERVICE)
S:SDSERVICE="N" SDSERVICE=0
I SDSERVICE'="@",SDSERVICE'="",'$F("^M^S^P^R^N^0^","^"_SDSERVICE_"^") D ERRLOG(93)
;
S SDNONCOUNT=$G(P8)
I SDNONCOUNT="@" S SDNONCOUNT="" ;Can't remove a required field
I 'EDIT,SDNONCOUNT="" D ERRLOG(94)
I '$$CHECKYN(SDNONCOUNT) D ERRLOG(95)
;
S SDDIVSION=$G(P9)
I 'EDIT,SDDIVSION="" S SDDIVSION=$$GET1^DIQ(40.8,"1,",.01,"I") ;Default
I SDDIVSION'="",SDDIVSION'="@" D
.I +SDDIVSION,$D(^DG(40.8,SDDIVSION,0)) Q
.S SDDIVSION=$O(^DG(40.8,"B",$E(SDDIVSION,1,30),""),-1)
.I 'SDDIVSION D ERRLOG(97)
;
S SDSTOPCODE=$G(P10)
I SDSTOPCODE="@" S SDSTOPCODE="" ;Can't remove a required field
I SDSTOPCODE'="",SDSTOPCODE'="@" D
.I +SDSTOPCODE=234 S POP=1 D ERRLOG(273)
.I +SDSTOPCODE,$$RESCHKFAILED^SDESUTIL(SDSTOPCODE,"P") D ERRLOG(290)
.; 860
.S SDINACTIVEDATE=$$GET1^DIQ(40.7,SDSTOPCODE,2,"I")
.I $G(SDINACTIVEDATE)'="",$G(SDINACTIVEDATE)<DT D ERRLOG(531) ;864
.I +SDSTOPCODE,$D(^DIC(40.7,SDSTOPCODE,0)) Q
.S SDSTOPCODE=$O(^DIC(40.7,"B",$E(SDSTOPCODE,1,30),""),-1)
.I 'SDSTOPCODE D ERRLOG(99)
;
S SDAPPTTYP=$G(P11)
I 'EDIT,SDAPPTTYP="" S SDAPPTTYP="REGULAR"
I SDAPPTTYP'="",SDAPPTTYP'="@" D
.I +SDAPPTTYP,$D(^SD(409.1,SDAPPTTYP,0)) Q
.S SDAPPTTYP=$O(^SD(409.1,"B",$E(SDAPPTTYP,1,30),""),-1)
.I 'SDAPPTTYP D ERRLOG(83)
;
S SDINPATMED=$G(P12)
I 'EDIT,SDINPATMED'="Y" S SDINPATMED="" ;Default
I '$$CHECKYN(SDINPATMED) D ERRLOG(122)
I SDINPATMED'="@",SDINPATMED'="Y" S SDINPATMED=""
I EDIT,SDINPATMED="" S SDINPATMED="@"
S SDINPATMED=$$YNTOBOOL^SDESCLINICSET2(SDINPATMED)
;
S SDPHONE=$G(P13)
S SDPHONEEXT=$G(P44)
I SDPHONEEXT'="" D
. I $L(SDPHONEEXT)>26 D ERRLOG(424)
;
S SDREQXRAY=$G(P14)
I 'EDIT,SDREQXRAY'="Y" S SDREQXRAY="" ;Default
I '$$CHECKYN(SDREQXRAY) D ERRLOG(123)
I SDREQXRAY'="@",SDREQXRAY'="Y" S SDREQXRAY=""
I EDIT,SDREQXRAY="" S SDREQXRAY="@"
;
S SDREQPROFILE=$G(P15)
I 'EDIT,SDREQPROFILE="" S SDREQPROFILE="Y" ;Default
I '$$CHECKYN(SDREQPROFILE) D ERRLOG(100)
S SDREQPROFILE=$$YNTOBOOL^SDESCLINICSET2(SDREQPROFILE)
I SDREQPROFILE?1N S SDREQPROFILE='SDREQPROFILE ;Because this field is defined oddly where 1=No and 0=Yes
;
S SDNOSHOWLET=$G(P16)
S SDNOSHOWLET=$$LETTERIEN^SDESCLINICSET2(SDNOSHOWLET,"No show")
;
S SDPREAPTLET=$G(P17)
S SDPREAPTLET=$$LETTERIEN^SDESCLINICSET2(SDPREAPTLET,"Pre appointment")
;
S SDCANLET=$G(P18)
S SDCANLET=$$LETTERIEN^SDESCLINICSET2(SDCANLET,"Clinic cancellation")
;
S SDAPTCANLET=$G(P19)
S SDAPTCANLET=$$LETTERIEN^SDESCLINICSET2(SDAPTCANLET,"Appointment cancellation")
;
S SDINOUTTIME=$G(P20)
I '$$CHECKYN(SDINOUTTIME) D ERRLOG(101)
S SDINOUTTIME=$$YNTOBOOL^SDESCLINICSET2(SDINOUTTIME)
;
; Provider IEN or # | Action
;
; Action = @ means remove this provider
; Action = D means set this provider as the default
; Action = @D means remove the default flag from the provider
;
; Remove default flag ; Delete provider ; Add or update provider and set as default ; Add provider
; Provider|@D ; Provider|@ ; Provider|D ; Provider
;
; EX: SMITH,JANE|@D;JAMES,JIM|;MACEY,MARY|@;ROBERTS,TIM
;
S SDPROVIDER=$G(P21)
D:SDPROVIDER'="" VALIDATEPROV^SDESCLINICSET2(SDPROVIDER,.PROVIDER,SDIEN)
;
S SDPRACTIONER=$G(P22)
I '$$CHECKYN(SDPRACTIONER) D ERRLOG(102)
S SDPRACTIONER=$$YNTOBOOL^SDESCLINICSET2(SDPRACTIONER)
;
; Diagnosis IEN or # | Action
;
; Action = @ means remove this diagnosis
; Action = D means set this diagnosis as the default
; Action = @D means remove the default flag from the diagnosis
;
; Remove default flag ; Delete Diagnosis ; Add or update Diagnosis and set as default ; Add diagnosis
; Diagnosis|@D ; Diagnosis|@ ; Diagnosis|D ; Diagnosis
;
S SDDIAG=$G(P23)
D:SDDIAG'="" VALIDATEDIAG^SDESCLINICSET2(SDDIAG,.DIAGNOSIS,SDIEN)
;
S SDWORKLOAD=$G(P24)
I '$$CHECKYN(SDWORKLOAD) D ERRLOG(103)
S SDWORKLOAD=$$YNTOBOOL^SDESCLINICSET2(SDWORKLOAD)
;
S SDALLOWNOSHW=$G(P25)
I SDALLOWNOSHW="@" S SDALLOWNOSHW="" ;Can't remove a required field
I 'EDIT,SDALLOWNOSHW="" D ERRLOG(104)
I SDALLOWNOSHW'="" D
.S SDALLOWNOSHW=SDALLOWNOSHW\1
.I SDALLOWNOSHW>999 D ERRLOG(105)
;
S SDMAXFUTBOOK=$G(P26)
I SDMAXFUTBOOK="@" S SDMAXFUTBOOK="" ;Can't remove a required field
I 'EDIT,SDMAXFUTBOOK="" D ERRLOG(106)
I SDMAXFUTBOOK'="" D
.S SDMAXFUTBOOK=SDMAXFUTBOOK\1
.I SDMAXFUTBOOK>999!(+SDMAXFUTBOOK<11) D ERRLOG(107)
;
S SDSCHEDHOLIDAY=$G(P27)
; SD*835 - block editing of 'Schedule on Holidays' field
I 'EDIT,SDSCHEDHOLIDAY'="Y" S SDSCHEDHOLIDAY=""
I EDIT,SDSCHEDHOLIDAY'=$$GET1^DIQ(44,SDIEN,1918.5,"I") D ERRLOG(405)
;
S SDCREDITSTOP=$G(P28)
I SDCREDITSTOP'="",SDCREDITSTOP'="@" D
.I +SDCREDITSTOP=234 S POP=1 D ERRLOG(273)
.I +SDCREDITSTOP,$$RESCHKFAILED^SDESUTIL(SDCREDITSTOP,"S") D ERRLOG(291)
.; 860
.S SDINACTIVEDATE=$$GET1^DIQ(40.7,SDCREDITSTOP,2,"I")
.I $G(SDINACTIVEDATE)'="",$G(SDINACTIVEDATE)<DT D ERRLOG(532) ;864
.I +SDCREDITSTOP,$D(^DIC(40.7,SDCREDITSTOP,0)) Q
.S SDCREDITSTOP=$O(^DIC(40.7,"B",$E(SDCREDITSTOP,1,30),""),-1)
.I 'SDCREDITSTOP D ERRLOG(109)
;
;When setting the clinic as Prohibit Access, a list of privileged users can be passed in.
;
; ex: Y;DOE,JANE;SMITH,JOHN|@
S SDNOACCESS=$G(P29)
D:SDNOACCESS'="" VALIDATEPPRIVUSR^SDESCLINICSET2(.SDNOACCESS,.PRIVLIAGEDUSER)
;
S SDLOCATION=$G(P30)
;
S SDPRINCLINIC=$G(P31)
I SDPRINCLINIC'="@",SDPRINCLINIC'="" D
.I +SDPRINCLINIC,$D(^SC(SDPRINCLINIC,0)) Q
.S SDPRINCLINIC=$O(^SC("B",$E(SDPRINCLINIC,1,30),""),-1)
.I SDPRINCLINIC="" D ERRLOG(110)
;
S SDOVBDAYMAX=$G(P32)
I SDOVBDAYMAX="@" S SDOVBDAYMAX="" ;Can't remove a required field
I 'EDIT,SDOVBDAYMAX="" D ERRLOG(111)
I SDOVBDAYMAX'="" D
.S SDOVBDAYMAX=SDOVBDAYMAX\1
.I SDOVBDAYMAX>9999 D ERRLOG(112)
;
;Delimited list of free test (MAX 80 chars) per delimited piece.
;ex: Instruction 1;Instruction 2
S SDSPECINSTRU=$G(P33)
D:SDSPECINSTRU'="" VALIDATESI^SDESCLINICSET2(SDSPECINSTRU,.SPECIALINSTRUCT)
;
S SDECHECKIN=$G(P34)
I 'EDIT,SDECHECKIN="" S SDECHECKIN="N" ;default
I '$$CHECKYN(SDECHECKIN) D ERRLOG(113)
S SDECHECKIN=$$YNTOBOOL^SDESCLINICSET2(SDECHECKIN)
;
S SDPRECHECKIN=$G(P35)
I 'EDIT,SDPRECHECKIN="" S SDPRECHECKIN="N" ;default
I '$$CHECKYN(SDPRECHECKIN) D ERRLOG(114)
S SDPRECHECKIN=$$YNTOBOOL^SDESCLINICSET2(SDPRECHECKIN)
;
S SDLENGTHOFAPT=$G(P36)
I EDIT D
.I SDLENGTHOFAPT="" Q
.I SDLENGTHOFAPT="@" D ERRLOG(115) Q
.S SDLENGTHOFAPT=SDLENGTHOFAPT\1
.I SDLENGTHOFAPT<10!(SDLENGTHOFAPT>240) D ERRLOG(116)
I 'EDIT D
.I SDLENGTHOFAPT="@" S SDLENGTHOFAPT="" ;Can't remove a required field
.I SDLENGTHOFAPT="" D ERRLOG(115) Q
.S SDLENGTHOFAPT=SDLENGTHOFAPT\1
.I SDLENGTHOFAPT<10!(SDLENGTHOFAPT>240) D ERRLOG(116)
;
S SDVARAPTLNG=$G(P37)
I SDVARAPTLNG="Y" S SDVARAPTLNG="V"
E S:SDVARAPTLNG'="@" SDVARAPTLNG=""
I EDIT,SDVARAPTLNG="" S SDVARAPTLNG="@"
;
S SDINCPERHR=$G(P38)
I 'EDIT D
.I SDINCPERHR="@" S SDINCPERHR="" ;Can't remove a required field
.I SDINCPERHR="" D ERRLOG(117) Q
.S ERR='$F("^60^30^20^15^10^","^"_SDINCPERHR_"^")
.I ERR S POP=1 D ERRLOG(118) Q
.S SDINCPERHR=60\SDINCPERHR
;
S SDSTARTHR=$G(P39)
I 'EDIT D
.I SDSTARTHR="" S SDSTARTHR=8 Q
.I SDSTARTHR'?1.2N D ERRLOG(119) Q
.S SDSTARTHR=+SDSTARTHR
.I SDSTARTHR<0!(SDSTARTHR>16) D ERRLOG(119)
;
S SDEAS=$G(P40)
I $L(SDEAS) S SDEAS=$$EASVALIDATE^SDESUTIL(SDEAS)
I SDEAS=-1 S POP=1 D ERRLOG(142)
;
I $L($G(P41))>120 S POP=1 D ERRLOG(253)
;
S PRIAMIS=$G(P42)
I PRIAMIS="@" S PRIAMIS=""
I PRIAMIS="",'EDIT,+SDSTOPCODE=0 D ERRLOG(272)
I PRIAMIS'="" D
. N PRIAMISNOTVALID
. S PRIAMISNOTVALID=$$VALIDATEAMIS^SDESUTIL(.PRIAMIS,"P")
. I PRIAMISNOTVALID S POP=1 D ERRLOG(PRIAMISNOTVALID) Q
. S SDSTOPCODE=PRIAMIS
.; 860
.S SDINACTIVEDATE=$$GET1^DIQ(40.7,PRIAMIS,2,"I")
.I $G(SDINACTIVEDATE)'="",$G(SDINACTIVEDATE)<DT D ERRLOG(512) ;864
;
S CREDITAMIS=$G(P43)
I CREDITAMIS="@" S SDCREDITSTOP=CREDITAMIS
I CREDITAMIS'="",(CREDITAMIS'="@") D
. N SECAMISNOTVALID
. S SECAMISNOTVALID=$$VALIDATEAMIS^SDESUTIL(.CREDITAMIS,"C")
. I SECAMISNOTVALID S POP=1 D ERRLOG(SECAMISNOTVALID) Q
. S SDCREDITSTOP=CREDITAMIS
.;860
.S SDINACTIVEDATE=$$GET1^DIQ(40.7,CREDITAMIS,2,"I")
.I $G(SDINACTIVEDATE)'="",$G(SDINACTIVEDATE)<DT D ERRLOG(513) ;864
;
; Primary & Credit Stop Codes can't be the same
I +SDSTOPCODE>0,+SDCREDITSTOP>0,SDSTOPCODE=SDCREDITSTOP S POP=1 D ERRLOG(380)
Q
;
ERRLOG(ERNUM,OPTIONALTXT) ;
S POP=1
D ERRLOG^SDESJSON(.SDCLINIC,$G(ERNUM),$G(OPTIONALTXT))
Q
;
CHECKYN(VAR) Q $$CHECKYN^SDESCLINICSET2(VAR)
;
BUILDER ;Convert data to JSON
N JSONERR
S JSONERR=""
D ENCODE^SDESJSON(.SDCLINIC,.RETURN,.JSONERR)
Q
;
CREATE ;
N X
S FDA(44,"+1,",.01)=SDNAME
S FDA(44,"+1,",1)=SDABR
S FDA(44,"+1,",2)="C" ;Type
S FDA(44,"+1,",2.1)=$$FIND1^DIC(40.9,,,"CLINIC") ;Type Extension pointer to 40.9
S FDA(44,"+1,",3.5)=SDDIVSION
S FDA(44,"+1,",8)=SDSTOPCODE
S FDA(44,"+1,",9)=SDSERVICE
S FDA(44,"+1,",10)=SDLOCATION
S FDA(44,"+1,",20)=SDECHECKIN
S FDA(44,"+1,",21)=SDPRECHECKIN
S FDA(44,"+1,",24)=SDINOUTTIME
S FDA(44,"+1,",30)=SDWORKLOAD
S FDA(44,"+1,",60)=SDPATNAME
S FDA(44,"+1,",61)=SDPATSCHED
S FDA(44,"+1,",62)=SDDISPAPPT
S FDA(44,"+1,",99)=SDPHONE
S FDA(44,"+1,",99.1)=SDPHONEEXT
S FDA(44,"+1,",1912)=SDLENGTHOFAPT
S FDA(44,"+1,",1913)=SDVARAPTLNG
S FDA(44,"+1,",1914)=SDSTARTHR
S FDA(44,"+1,",1916)=SDPRINCLINIC
S FDA(44,"+1,",1917)=SDINCPERHR
S FDA(44,"+1,",1918)=SDOVBDAYMAX
S FDA(44,"+1,",1918.5)=SDSCHEDHOLIDAY
S FDA(44,"+1,",2000)=SDREQXRAY
S FDA(44,"+1,",2000.5)=SDREQPROFILE
S FDA(44,"+1,",2001)=SDALLOWNOSHW
S FDA(44,"+1,",2002)=SDMAXFUTBOOK
S FDA(44,"+1,",2500)=SDNOACCESS
S FDA(44,"+1,",2502)=SDNONCOUNT
S FDA(44,"+1,",2503)=SDCREDITSTOP
S FDA(44,"+1,",2504)=SDMEETATFAC
S FDA(44,"+1,",2507)=SDAPPTTYP
S FDA(44,"+1,",2508)=SDNOSHOWLET
S FDA(44,"+1,",2509)=SDPREAPTLET
S FDA(44,"+1,",2510)=SDCANLET
S FDA(44,"+1,",2511)=SDAPTCANLET
S FDA(44,"+1,",2801)=SDPRACTIONER
S FDA(44,"+1,",2802)=SDINPATMED
Q
;
UPDATE ;
N X
S X=SDIEN
S:SDNAME'="" FDA(44,X_",",.01)=SDNAME
S:SDABR'="" FDA(44,X_",",1)=SDABR
S:SDDIVSION'="" FDA(44,X_",",3.5)=SDDIVSION
S:SDSTOPCODE'="" FDA(44,X_",",8)=SDSTOPCODE
S:SDSERVICE'="" FDA(44,X_",",9)=SDSERVICE
S:SDLOCATION'="" FDA(44,X_",",10)=SDLOCATION
S:SDECHECKIN'="" FDA(44,X_",",20)=SDECHECKIN
S:SDPRECHECKIN'="" FDA(44,X_",",21)=SDPRECHECKIN
S:SDINOUTTIME'="" FDA(44,X_",",24)=SDINOUTTIME
S:SDWORKLOAD'="" FDA(44,X_",",30)=SDWORKLOAD
S:SDPATNAME'="" FDA(44,X_",",60)=SDPATNAME
S:SDPATSCHED'="" FDA(44,X_",",61)=SDPATSCHED
S:SDDISPAPPT'="" FDA(44,X_",",62)=SDDISPAPPT
S:SDPHONE'="" FDA(44,X_",",99)=SDPHONE
S:SDPHONEEXT'="" FDA(44,X_",",99.1)=SDPHONEEXT
S:SDLENGTHOFAPT'="" FDA(44,X_",",1912)=SDLENGTHOFAPT
S:SDVARAPTLNG'="" FDA(44,X_",",1913)=SDVARAPTLNG
S:SDPRINCLINIC'="" FDA(44,X_",",1916)=SDPRINCLINIC
S:SDOVBDAYMAX'="" FDA(44,X_",",1918)=SDOVBDAYMAX
S:SDREQXRAY'="" FDA(44,X_",",2000)=SDREQXRAY
S:SDREQPROFILE'="" FDA(44,X_",",2000.5)=SDREQPROFILE
S:SDALLOWNOSHW'="" FDA(44,X_",",2001)=SDALLOWNOSHW
S:SDMAXFUTBOOK'="" FDA(44,X_",",2002)=SDMAXFUTBOOK
S:SDNOACCESS'="" FDA(44,X_",",2500)=SDNOACCESS
S:SDNONCOUNT'="" FDA(44,X_",",2502)=SDNONCOUNT
S:SDCREDITSTOP'="" FDA(44,X_",",2503)=SDCREDITSTOP
S:SDMEETATFAC'="" FDA(44,X_",",2504)=SDMEETATFAC
S:SDAPPTTYP'="" FDA(44,X_",",2507)=SDAPPTTYP
S:SDNOSHOWLET'="" FDA(44,X_",",2508)=SDNOSHOWLET
S:SDPREAPTLET'="" FDA(44,X_",",2509)=SDPREAPTLET
S:SDCANLET'="" FDA(44,X_",",2510)=SDCANLET
S:SDAPTCANLET'="" FDA(44,X_",",2511)=SDAPTCANLET
S:SDPRACTIONER'="" FDA(44,X_",",2801)=SDPRACTIONER
S:SDINPATMED'="" FDA(44,X_",",2802)=SDINPATMED
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDESCLINICSET 18027 printed Nov 22, 2024@18:06:04 Page 2
SDESCLINICSET ;ALB/TAW,MGD,BWF,LAB,MGD,ANU,DJS - CLINIC CREATE AND UPDATE ;OCT 24, 2023
+1 ;;5.3;Scheduling;**799,805,820,824,825,831,835,836,857,860,864**;Aug 13, 1993;Build 15
+2 ;;Per VHA Directive 6402, this routine should not be modified
+3 ;
+4 ; Reference to ^DG(40.8 is supported by IA #2295
+5 ; Reference to ^DG(40.8 is supported by IA #7024
+6 ;
+7 ; SDNAME - [TEXT, REQ] Clinic Name
+8 ; SDABR - [TEXT] ABBREVIATION
+9 ; SDPATNAME - [TEXT] PATIENT FRIENDLY NAME
+10 ; SDMEETATFAC - [Y/N] CLINIC MEETS AT THIS FACILITY? (Default = Y)
+11 ; SDPATSCHED - [Y/N, REQ] ALLOW DIRECT PATIENT SCHEDULING?
+12 ; SDDISPAPPT - [Y/N, REQ] DISPLAY CLIN APPT TO PATIENTS?
+13 ; SDSERVICE - [Set of codes, REQ] SERVICE
+14 ; SDNONCOUNT - [Y/N, REQ] NON-COUNT CLINIC? (Y OR N)
+15 ; SDDIVSION - [File 40.8] DIVISION
+16 ; SDSTOPCODE - [File 40.7, REQ] STOP CODE NUMBER
+17 ; SDAPPTTYP - [File 409.1] DEFAULT APPOINTMENT TYPE
+18 ; SDINPATMED - [Y/N] ADMINISTER INPATIENT MEDS?
+19 ; SDPHONE - [TEXT] TELEPHONE
+20 ; SDREQXRAY - [Y/N] REQUIRE X-RAY FILMS?
+21 ; SDREQPROFILE - [Y/N] REQUIRE ACTION PROFILES?
+22 ; SDNOSHOWLET - [File 407.5] NO SHOW LETTER
+23 ; SDPREAPTLET - [File 407.5] PRE-APPOINTMENT LETTER
+24 ; SDCANLET - [File 407.5] CLINIC CANCELLATION LETTER
+25 ; SDAPTCANLET - [File 407.5] APPT. CANCELLATION LETTER
+26 ; SDINOUTTIME - [Y/N] ASK FOR CHECK IN/OUT TIME
+27 ; SDPROVIDER - [File 200] PROVIDER
+28 ; SDPRACTIONER - [Y/N] DEFAULT TO PC PRACTITIONER?
+29 ; SDDIAG - [file 80] DIAGNOSIS
+30 ; SDWORKLOAD - [Y/N] WORKLOAD VALIDATION AT CHK OUT
+31 ; SDALLOWNOSHW - [NUM, REQ] ALLOWABLE CONSECUTIVE NO-SHOWS
+32 ; SDMACFUTBOOK - [NUM, REQ] MAX # DAYS FOR FUTURE BOOKING
+33 ; SDSCHEDHOLIDAY - [Y/N] SCHEDULE ON HOLIDAYS?
+34 ; SDCREDITSTOP - [File 40.7] CREDIT STOP CODE
+35 ; SDNOACCESS - [Y/N] PROHIBIT ACCESS TO CLINIC?
+36 ; SDLOCATION - [TEXT] PHYSICAL LOCATION
+37 ; SDPRINCLINIC - [File 44] PRINCIPAL Clinic
+38 ; SDOVBDAYMAX - [NUM, REQ] OVERBOOKS/DAY MAXIMUM
+39 ; SDSPECINSTRU - [TEXT] SPECIAL INSTRUCTIONS
+40 ; SDECHECKIN - [Y/N] E-CHECKIN ALLOWED
+41 ; SDPRECJECKIN - [Y/N] PRE-CHECKIN ALLOWED NO
+42 ; SDLENGTHOFAPT - [NUM, REQ] LENGTH OF APP'T
+43 ; SDVARAPTLNG - [TEXT] VARIABLE APP'NTMENT LENGTH
+44 ; SDINCPERHR - [NUM, REQ] DISPLAY INCRUMENTS PER HOUR
+45 ; SDSTARTHR - [NUM] HOUR CLINIC DISPLAY BEGINS (Default = 8)
+46 ; SDEAS - [TEXT OPT] Enterprise Appointment Scheduling (EAS) Tracking Number associated to an appointment.
+47 ; HASH - [TEXT] SHA-1 Hash value that the calling app has stored
+48 ; PRIAMIS - [NUM, OPT] AMIS Primary Stop Code
+49 ; CREDITAMIS - [NUM, OPT] AMIS Credit Stop Code
+50 ;
CLINICEDIT(RET,CLINIEN,P1,P2,P3,P4,P5,P6,P7,P8,P9,P10,P11,P12,P13,P14,P15,P16,P17,P18,P19,P20,P21,P22,P23,P24,P25,P26,P27,P28,P29,P30,P31,P32,P33,P34,P35,P36,P37,P38,P39,P40,P41,P42,P43,P44) ;
+1 SET CLINIEN=$GET(CLINIEN,"")
+2 ;Flag missing ARIEN when calling the update RPC
if CLINIEN=""
SET CLINIEN=-1
+3 SET P1=$GET(P1)
SET P2=$GET(P2)
SET P3=$GET(P3)
SET P4=$GET(P4)
SET P5=$GET(P5)
SET P6=$GET(P6)
SET P7=$GET(P7)
SET P8=$GET(P8)
SET P9=$GET(P9)
SET P10=$GET(P10)
SET P11=$GET(P11)
SET P12=$GET(P12)
SET P13=$GET(P13)
SET P14=$GET(P14)
SET P15=$GET(P15)
SET P16=$GET(P16)
SET P17=$GET(P17)
+4 SET P18=$GET(P18)
SET P19=$GET(P19)
SET P20=$GET(P20)
SET P21=$GET(P21)
SET P22=$GET(P22)
SET P23=$GET(P23)
+5 SET P24=$GET(P24)
SET P25=$GET(P25)
SET P26=$GET(P26)
SET P27=$GET(P27)
SET P28=$GET(P28)
SET P29=$GET(P29)
SET P30=$GET(P30)
SET P31=$GET(P31)
SET P32=$GET(P32)
SET P33=$GET(P33)
SET P34=$GET(P34)
SET P35=$GET(P35)
SET P36=$GET(P36)
SET P37=$GET(P37)
SET P38=$GET(P38)
SET P39=$GET(P39)
SET P40=$GET(P40)
+6 SET P41=$GET(P41)
SET P42=$GET(P42)
SET P43=$GET(P43)
SET P44=$GET(P44)
+7 DO CLINICSET^SDESCLINICSET(.RET,CLINIEN,P1,P2,P3,P4,P5,P6,P7,P8,P9,P10,P11,P12,P13,P14,P15,P16,P17,P18,P19,P20,P21,P22,P23,P24,P25,P26,P27,P28,P29,P30,P31,P32,P33,P34,P35,P36,P37,P38,P39,P40,P41,P42,P43,P44)
+8 QUIT
+9 ;
CLINICSET(RETURN,P0,P1,P2,P3,P4,P5,P6,P7,P8,P9,P10,P11,P12,P13,P14,P15,P16,P17,P18,P19,P20,P21,P22,P23,P24,P25,P26,P27,P28,P29,P30,P31,P32,P33,P34,P35,P36,P37,P38,P39,P40,P41,P42,P43,P44) ;
+1 NEW SDCLINIC,SDNAME,SDABR,SDPATNAME,SDMEETATFAC,SDPATSCHED,SDDISPAPPT,SDSERVICE,SDNONCOUNT,SDDIVSION,SDSTOPCODE,SDAPPTTYP,SDIEN
+2 NEW SDINPATMED,SDPHONE,SDREQXRAY,SDREQPROFILE,SDNOSHOWLET,SDPREAPTLET,SDCANLET,SDAPTCANLET,SDINOUTTIME,SDPROVIDER,SDPRACTIONER
+3 NEW SDDIAG,SDWORKLOAD,SDALLOWNOSHW,SDMAXFUTBOOK,SDSTTMAUTOBOOK,SDMAXDAYREBOOK,SDSCHEDHOLIDAY,SDCREDITSTOP,SDNOACCESS,SDFHRCLINBEGIN
+4 NEW SDLOCATION,SDPRINCLINIC,SDOVBDAYMAX,SDSPECINSTRU,SDECHECKIN,SDPRECHECKIN,SDLENGTHOFAPT,SDVARAPTLNG,POP,SDINCPERHR,DEFAULTNEW
+5 NEW I,PROV,PROVIDER,DIAG,DIAGNOSIS,INSTRUCTION,SPECIALINSTRUCT,PROVDATA,DEFAULT,KEY,DIAGDATA,DEFAULT,DEFAULTCNT,DEFAULTFLAG,ACTION
+6 NEW DEFAULTCNT2,DEFALUTREMOVE,X,PRIVUSER,PRIVLIAGEDUSER,MI,SDSTARTHR,ERR,FDA,SDEAS,PRIAMIS,CREDITAMIS,SDPHONEEXT,SDINACTIVEDATE
+7 SET POP=0
+8 IF P0=""
Begin DoDot:1
+9 DO VALIDATE(0)
+10 IF 'POP
DO CREATE
End DoDot:1
+11 IF P0'=""
Begin DoDot:1
+12 DO VALIDATE(1)
+13 IF 'POP
DO UPDATE
+14 if ('POP)&($GET(P41)'="")
DO CHECKHASH(.SDERROR,P0,P41)
End DoDot:1
+15 IF 'POP
DO SAVE^SDESCLINICSET2(.POP,SDIEN,.FDA,.SDCLINIC,.PROVIDER,.DIAGNOSIS,.SPECIALINSTRUCT,.PRIVLIAGEDUSER)
+16 DO BUILDER
+17 QUIT
+18 ;
CHECKHASH(SDERROR,CLIN,INPUTHASH) ;
+1 NEW CURHASH
+2 SET CURHASH=$$GET1^DIQ(44,CLIN,2900,"I")
+3 if CURHASH'=INPUTHASH
DO ERRLOG(252)
+4 QUIT
+5 ;
VALIDATE(EDIT) ;
+1 SET SDIEN=$GET(P0)
+2 IF SDIEN'=""
Begin DoDot:1
+3 ; If the Update RPC is called and no SDIEN is sent then it will show as -1
+4 IF SDIEN=-1
DO ERRLOG(18)
QUIT
+5 IF '$DATA(^SC(SDIEN,0))
DO ERRLOG(19)
End DoDot:1
+6 ;
+7 SET SDNAME=$GET(P1)
+8 ;Can't remove the name
IF SDNAME="@"
SET SDNAME=""
+9 IF 'EDIT
IF SDNAME=""
DO ERRLOG(50)
+10 IF SDNAME'=""
IF $DATA(^SC("B",$EXTRACT(SDNAME,1,30)))
DO ERRLOG(51,"Name already in use")
+11 ;
+12 SET SDABR=$GET(P2)
+13 IF $LENGTH(SDABR)>7
DO ERRLOG(251)
+14 ;
+15 SET SDPATNAME=$GET(P3)
+16 ;
+17 SET SDMEETATFAC=$GET(P4)
+18 ;Default to Y
IF 'EDIT
IF SDMEETATFAC=""
SET SDMEETATFAC="Y"
+19 IF '$$CHECKYN(SDMEETATFAC)
DO ERRLOG(87)
+20 ;
+21 SET SDPATSCHED=$GET(P5)
+22 ;Can't remove a required field
IF SDPATSCHED="@"
SET SDPATSCHED=""
+23 IF 'EDIT
IF SDPATSCHED=""
DO ERRLOG(88)
+24 IF '$$CHECKYN(SDPATSCHED)
DO ERRLOG(89)
+25 ;
+26 SET SDDISPAPPT=$GET(P6)
+27 ;Can't remove a required field
IF SDDISPAPPT="@"
SET SDDISPAPPT=""
+28 IF 'EDIT
IF SDDISPAPPT=""
DO ERRLOG(90)
+29 IF '$$CHECKYN(SDDISPAPPT)
DO ERRLOG(91)
+30 ;
+31 SET SDSERVICE=$GET(P7)
+32 ;Can't remove a required field
IF SDSERVICE="@"
SET SDSERVICE=""
+33 IF 'EDIT
IF SDSERVICE=""
DO ERRLOG(92)
+34 SET SDSERVICE=$EXTRACT(SDSERVICE)
+35 if SDSERVICE="N"
SET SDSERVICE=0
+36 IF SDSERVICE'="@"
IF SDSERVICE'=""
IF '$FIND("^M^S^P^R^N^0^","^"_SDSERVICE_"^")
DO ERRLOG(93)
+37 ;
+38 SET SDNONCOUNT=$GET(P8)
+39 ;Can't remove a required field
IF SDNONCOUNT="@"
SET SDNONCOUNT=""
+40 IF 'EDIT
IF SDNONCOUNT=""
DO ERRLOG(94)
+41 IF '$$CHECKYN(SDNONCOUNT)
DO ERRLOG(95)
+42 ;
+43 SET SDDIVSION=$GET(P9)
+44 ;Default
IF 'EDIT
IF SDDIVSION=""
SET SDDIVSION=$$GET1^DIQ(40.8,"1,",.01,"I")
+45 IF SDDIVSION'=""
IF SDDIVSION'="@"
Begin DoDot:1
+46 IF +SDDIVSION
IF $DATA(^DG(40.8,SDDIVSION,0))
QUIT
+47 SET SDDIVSION=$ORDER(^DG(40.8,"B",$EXTRACT(SDDIVSION,1,30),""),-1)
+48 IF 'SDDIVSION
DO ERRLOG(97)
End DoDot:1
+49 ;
+50 SET SDSTOPCODE=$GET(P10)
+51 ;Can't remove a required field
IF SDSTOPCODE="@"
SET SDSTOPCODE=""
+52 IF SDSTOPCODE'=""
IF SDSTOPCODE'="@"
Begin DoDot:1
+53 IF +SDSTOPCODE=234
SET POP=1
DO ERRLOG(273)
+54 IF +SDSTOPCODE
IF $$RESCHKFAILED^SDESUTIL(SDSTOPCODE,"P")
DO ERRLOG(290)
+55 ; 860
+56 SET SDINACTIVEDATE=$$GET1^DIQ(40.7,SDSTOPCODE,2,"I")
+57 ;864
IF $GET(SDINACTIVEDATE)'=""
IF $GET(SDINACTIVEDATE)<DT
DO ERRLOG(531)
+58 IF +SDSTOPCODE
IF $DATA(^DIC(40.7,SDSTOPCODE,0))
QUIT
+59 SET SDSTOPCODE=$ORDER(^DIC(40.7,"B",$EXTRACT(SDSTOPCODE,1,30),""),-1)
+60 IF 'SDSTOPCODE
DO ERRLOG(99)
End DoDot:1
+61 ;
+62 SET SDAPPTTYP=$GET(P11)
+63 IF 'EDIT
IF SDAPPTTYP=""
SET SDAPPTTYP="REGULAR"
+64 IF SDAPPTTYP'=""
IF SDAPPTTYP'="@"
Begin DoDot:1
+65 IF +SDAPPTTYP
IF $DATA(^SD(409.1,SDAPPTTYP,0))
QUIT
+66 SET SDAPPTTYP=$ORDER(^SD(409.1,"B",$EXTRACT(SDAPPTTYP,1,30),""),-1)
+67 IF 'SDAPPTTYP
DO ERRLOG(83)
End DoDot:1
+68 ;
+69 SET SDINPATMED=$GET(P12)
+70 ;Default
IF 'EDIT
IF SDINPATMED'="Y"
SET SDINPATMED=""
+71 IF '$$CHECKYN(SDINPATMED)
DO ERRLOG(122)
+72 IF SDINPATMED'="@"
IF SDINPATMED'="Y"
SET SDINPATMED=""
+73 IF EDIT
IF SDINPATMED=""
SET SDINPATMED="@"
+74 SET SDINPATMED=$$YNTOBOOL^SDESCLINICSET2(SDINPATMED)
+75 ;
+76 SET SDPHONE=$GET(P13)
+77 SET SDPHONEEXT=$GET(P44)
+78 IF SDPHONEEXT'=""
Begin DoDot:1
+79 IF $LENGTH(SDPHONEEXT)>26
DO ERRLOG(424)
End DoDot:1
+80 ;
+81 SET SDREQXRAY=$GET(P14)
+82 ;Default
IF 'EDIT
IF SDREQXRAY'="Y"
SET SDREQXRAY=""
+83 IF '$$CHECKYN(SDREQXRAY)
DO ERRLOG(123)
+84 IF SDREQXRAY'="@"
IF SDREQXRAY'="Y"
SET SDREQXRAY=""
+85 IF EDIT
IF SDREQXRAY=""
SET SDREQXRAY="@"
+86 ;
+87 SET SDREQPROFILE=$GET(P15)
+88 ;Default
IF 'EDIT
IF SDREQPROFILE=""
SET SDREQPROFILE="Y"
+89 IF '$$CHECKYN(SDREQPROFILE)
DO ERRLOG(100)
+90 SET SDREQPROFILE=$$YNTOBOOL^SDESCLINICSET2(SDREQPROFILE)
+91 ;Because this field is defined oddly where 1=No and 0=Yes
IF SDREQPROFILE?1N
SET SDREQPROFILE='SDREQPROFILE
+92 ;
+93 SET SDNOSHOWLET=$GET(P16)
+94 SET SDNOSHOWLET=$$LETTERIEN^SDESCLINICSET2(SDNOSHOWLET,"No show")
+95 ;
+96 SET SDPREAPTLET=$GET(P17)
+97 SET SDPREAPTLET=$$LETTERIEN^SDESCLINICSET2(SDPREAPTLET,"Pre appointment")
+98 ;
+99 SET SDCANLET=$GET(P18)
+100 SET SDCANLET=$$LETTERIEN^SDESCLINICSET2(SDCANLET,"Clinic cancellation")
+101 ;
+102 SET SDAPTCANLET=$GET(P19)
+103 SET SDAPTCANLET=$$LETTERIEN^SDESCLINICSET2(SDAPTCANLET,"Appointment cancellation")
+104 ;
+105 SET SDINOUTTIME=$GET(P20)
+106 IF '$$CHECKYN(SDINOUTTIME)
DO ERRLOG(101)
+107 SET SDINOUTTIME=$$YNTOBOOL^SDESCLINICSET2(SDINOUTTIME)
+108 ;
+109 ; Provider IEN or # | Action
+110 ;
+111 ; Action = @ means remove this provider
+112 ; Action = D means set this provider as the default
+113 ; Action = @D means remove the default flag from the provider
+114 ;
+115 ; Remove default flag ; Delete provider ; Add or update provider and set as default ; Add provider
+116 ; Provider|@D ; Provider|@ ; Provider|D ; Provider
+117 ;
+118 ; EX: SMITH,JANE|@D;JAMES,JIM|;MACEY,MARY|@;ROBERTS,TIM
+119 ;
+120 SET SDPROVIDER=$GET(P21)
+121 if SDPROVIDER'=""
DO VALIDATEPROV^SDESCLINICSET2(SDPROVIDER,.PROVIDER,SDIEN)
+122 ;
+123 SET SDPRACTIONER=$GET(P22)
+124 IF '$$CHECKYN(SDPRACTIONER)
DO ERRLOG(102)
+125 SET SDPRACTIONER=$$YNTOBOOL^SDESCLINICSET2(SDPRACTIONER)
+126 ;
+127 ; Diagnosis IEN or # | Action
+128 ;
+129 ; Action = @ means remove this diagnosis
+130 ; Action = D means set this diagnosis as the default
+131 ; Action = @D means remove the default flag from the diagnosis
+132 ;
+133 ; Remove default flag ; Delete Diagnosis ; Add or update Diagnosis and set as default ; Add diagnosis
+134 ; Diagnosis|@D ; Diagnosis|@ ; Diagnosis|D ; Diagnosis
+135 ;
+136 SET SDDIAG=$GET(P23)
+137 if SDDIAG'=""
DO VALIDATEDIAG^SDESCLINICSET2(SDDIAG,.DIAGNOSIS,SDIEN)
+138 ;
+139 SET SDWORKLOAD=$GET(P24)
+140 IF '$$CHECKYN(SDWORKLOAD)
DO ERRLOG(103)
+141 SET SDWORKLOAD=$$YNTOBOOL^SDESCLINICSET2(SDWORKLOAD)
+142 ;
+143 SET SDALLOWNOSHW=$GET(P25)
+144 ;Can't remove a required field
IF SDALLOWNOSHW="@"
SET SDALLOWNOSHW=""
+145 IF 'EDIT
IF SDALLOWNOSHW=""
DO ERRLOG(104)
+146 IF SDALLOWNOSHW'=""
Begin DoDot:1
+147 SET SDALLOWNOSHW=SDALLOWNOSHW\1
+148 IF SDALLOWNOSHW>999
DO ERRLOG(105)
End DoDot:1
+149 ;
+150 SET SDMAXFUTBOOK=$GET(P26)
+151 ;Can't remove a required field
IF SDMAXFUTBOOK="@"
SET SDMAXFUTBOOK=""
+152 IF 'EDIT
IF SDMAXFUTBOOK=""
DO ERRLOG(106)
+153 IF SDMAXFUTBOOK'=""
Begin DoDot:1
+154 SET SDMAXFUTBOOK=SDMAXFUTBOOK\1
+155 IF SDMAXFUTBOOK>999!(+SDMAXFUTBOOK<11)
DO ERRLOG(107)
End DoDot:1
+156 ;
+157 SET SDSCHEDHOLIDAY=$GET(P27)
+158 ; SD*835 - block editing of 'Schedule on Holidays' field
+159 IF 'EDIT
IF SDSCHEDHOLIDAY'="Y"
SET SDSCHEDHOLIDAY=""
+160 IF EDIT
IF SDSCHEDHOLIDAY'=$$GET1^DIQ(44,SDIEN,1918.5,"I")
DO ERRLOG(405)
+161 ;
+162 SET SDCREDITSTOP=$GET(P28)
+163 IF SDCREDITSTOP'=""
IF SDCREDITSTOP'="@"
Begin DoDot:1
+164 IF +SDCREDITSTOP=234
SET POP=1
DO ERRLOG(273)
+165 IF +SDCREDITSTOP
IF $$RESCHKFAILED^SDESUTIL(SDCREDITSTOP,"S")
DO ERRLOG(291)
+166 ; 860
+167 SET SDINACTIVEDATE=$$GET1^DIQ(40.7,SDCREDITSTOP,2,"I")
+168 ;864
IF $GET(SDINACTIVEDATE)'=""
IF $GET(SDINACTIVEDATE)<DT
DO ERRLOG(532)
+169 IF +SDCREDITSTOP
IF $DATA(^DIC(40.7,SDCREDITSTOP,0))
QUIT
+170 SET SDCREDITSTOP=$ORDER(^DIC(40.7,"B",$EXTRACT(SDCREDITSTOP,1,30),""),-1)
+171 IF 'SDCREDITSTOP
DO ERRLOG(109)
End DoDot:1
+172 ;
+173 ;When setting the clinic as Prohibit Access, a list of privileged users can be passed in.
+174 ;
+175 ; ex: Y;DOE,JANE;SMITH,JOHN|@
+176 SET SDNOACCESS=$GET(P29)
+177 if SDNOACCESS'=""
DO VALIDATEPPRIVUSR^SDESCLINICSET2(.SDNOACCESS,.PRIVLIAGEDUSER)
+178 ;
+179 SET SDLOCATION=$GET(P30)
+180 ;
+181 SET SDPRINCLINIC=$GET(P31)
+182 IF SDPRINCLINIC'="@"
IF SDPRINCLINIC'=""
Begin DoDot:1
+183 IF +SDPRINCLINIC
IF $DATA(^SC(SDPRINCLINIC,0))
QUIT
+184 SET SDPRINCLINIC=$ORDER(^SC("B",$EXTRACT(SDPRINCLINIC,1,30),""),-1)
+185 IF SDPRINCLINIC=""
DO ERRLOG(110)
End DoDot:1
+186 ;
+187 SET SDOVBDAYMAX=$GET(P32)
+188 ;Can't remove a required field
IF SDOVBDAYMAX="@"
SET SDOVBDAYMAX=""
+189 IF 'EDIT
IF SDOVBDAYMAX=""
DO ERRLOG(111)
+190 IF SDOVBDAYMAX'=""
Begin DoDot:1
+191 SET SDOVBDAYMAX=SDOVBDAYMAX\1
+192 IF SDOVBDAYMAX>9999
DO ERRLOG(112)
End DoDot:1
+193 ;
+194 ;Delimited list of free test (MAX 80 chars) per delimited piece.
+195 ;ex: Instruction 1;Instruction 2
+196 SET SDSPECINSTRU=$GET(P33)
+197 if SDSPECINSTRU'=""
DO VALIDATESI^SDESCLINICSET2(SDSPECINSTRU,.SPECIALINSTRUCT)
+198 ;
+199 SET SDECHECKIN=$GET(P34)
+200 ;default
IF 'EDIT
IF SDECHECKIN=""
SET SDECHECKIN="N"
+201 IF '$$CHECKYN(SDECHECKIN)
DO ERRLOG(113)
+202 SET SDECHECKIN=$$YNTOBOOL^SDESCLINICSET2(SDECHECKIN)
+203 ;
+204 SET SDPRECHECKIN=$GET(P35)
+205 ;default
IF 'EDIT
IF SDPRECHECKIN=""
SET SDPRECHECKIN="N"
+206 IF '$$CHECKYN(SDPRECHECKIN)
DO ERRLOG(114)
+207 SET SDPRECHECKIN=$$YNTOBOOL^SDESCLINICSET2(SDPRECHECKIN)
+208 ;
+209 SET SDLENGTHOFAPT=$GET(P36)
+210 IF EDIT
Begin DoDot:1
+211 IF SDLENGTHOFAPT=""
QUIT
+212 IF SDLENGTHOFAPT="@"
DO ERRLOG(115)
QUIT
+213 SET SDLENGTHOFAPT=SDLENGTHOFAPT\1
+214 IF SDLENGTHOFAPT<10!(SDLENGTHOFAPT>240)
DO ERRLOG(116)
End DoDot:1
+215 IF 'EDIT
Begin DoDot:1
+216 ;Can't remove a required field
IF SDLENGTHOFAPT="@"
SET SDLENGTHOFAPT=""
+217 IF SDLENGTHOFAPT=""
DO ERRLOG(115)
QUIT
+218 SET SDLENGTHOFAPT=SDLENGTHOFAPT\1
+219 IF SDLENGTHOFAPT<10!(SDLENGTHOFAPT>240)
DO ERRLOG(116)
End DoDot:1
+220 ;
+221 SET SDVARAPTLNG=$GET(P37)
+222 IF SDVARAPTLNG="Y"
SET SDVARAPTLNG="V"
+223 IF '$TEST
if SDVARAPTLNG'="@"
SET SDVARAPTLNG=""
+224 IF EDIT
IF SDVARAPTLNG=""
SET SDVARAPTLNG="@"
+225 ;
+226 SET SDINCPERHR=$GET(P38)
+227 IF 'EDIT
Begin DoDot:1
+228 ;Can't remove a required field
IF SDINCPERHR="@"
SET SDINCPERHR=""
+229 IF SDINCPERHR=""
DO ERRLOG(117)
QUIT
+230 SET ERR='$FIND("^60^30^20^15^10^","^"_SDINCPERHR_"^")
+231 IF ERR
SET POP=1
DO ERRLOG(118)
QUIT
+232 SET SDINCPERHR=60\SDINCPERHR
End DoDot:1
+233 ;
+234 SET SDSTARTHR=$GET(P39)
+235 IF 'EDIT
Begin DoDot:1
+236 IF SDSTARTHR=""
SET SDSTARTHR=8
QUIT
+237 IF SDSTARTHR'?1.2N
DO ERRLOG(119)
QUIT
+238 SET SDSTARTHR=+SDSTARTHR
+239 IF SDSTARTHR<0!(SDSTARTHR>16)
DO ERRLOG(119)
End DoDot:1
+240 ;
+241 SET SDEAS=$GET(P40)
+242 IF $LENGTH(SDEAS)
SET SDEAS=$$EASVALIDATE^SDESUTIL(SDEAS)
+243 IF SDEAS=-1
SET POP=1
DO ERRLOG(142)
+244 ;
+245 IF $LENGTH($GET(P41))>120
SET POP=1
DO ERRLOG(253)
+246 ;
+247 SET PRIAMIS=$GET(P42)
+248 IF PRIAMIS="@"
SET PRIAMIS=""
+249 IF PRIAMIS=""
IF 'EDIT
IF +SDSTOPCODE=0
DO ERRLOG(272)
+250 IF PRIAMIS'=""
Begin DoDot:1
+251 NEW PRIAMISNOTVALID
+252 SET PRIAMISNOTVALID=$$VALIDATEAMIS^SDESUTIL(.PRIAMIS,"P")
+253 IF PRIAMISNOTVALID
SET POP=1
DO ERRLOG(PRIAMISNOTVALID)
QUIT
+254 SET SDSTOPCODE=PRIAMIS
+255 ; 860
+256 SET SDINACTIVEDATE=$$GET1^DIQ(40.7,PRIAMIS,2,"I")
+257 ;864
IF $GET(SDINACTIVEDATE)'=""
IF $GET(SDINACTIVEDATE)<DT
DO ERRLOG(512)
End DoDot:1
+258 ;
+259 SET CREDITAMIS=$GET(P43)
+260 IF CREDITAMIS="@"
SET SDCREDITSTOP=CREDITAMIS
+261 IF CREDITAMIS'=""
IF (CREDITAMIS'="@")
Begin DoDot:1
+262 NEW SECAMISNOTVALID
+263 SET SECAMISNOTVALID=$$VALIDATEAMIS^SDESUTIL(.CREDITAMIS,"C")
+264 IF SECAMISNOTVALID
SET POP=1
DO ERRLOG(SECAMISNOTVALID)
QUIT
+265 SET SDCREDITSTOP=CREDITAMIS
+266 ;860
+267 SET SDINACTIVEDATE=$$GET1^DIQ(40.7,CREDITAMIS,2,"I")
+268 ;864
IF $GET(SDINACTIVEDATE)'=""
IF $GET(SDINACTIVEDATE)<DT
DO ERRLOG(513)
End DoDot:1
+269 ;
+270 ; Primary & Credit Stop Codes can't be the same
+271 IF +SDSTOPCODE>0
IF +SDCREDITSTOP>0
IF SDSTOPCODE=SDCREDITSTOP
SET POP=1
DO ERRLOG(380)
+272 QUIT
+273 ;
ERRLOG(ERNUM,OPTIONALTXT) ;
+1 SET POP=1
+2 DO ERRLOG^SDESJSON(.SDCLINIC,$GET(ERNUM),$GET(OPTIONALTXT))
+3 QUIT
+4 ;
CHECKYN(VAR) QUIT $$CHECKYN^SDESCLINICSET2(VAR)
+1 ;
BUILDER ;Convert data to JSON
+1 NEW JSONERR
+2 SET JSONERR=""
+3 DO ENCODE^SDESJSON(.SDCLINIC,.RETURN,.JSONERR)
+4 QUIT
+5 ;
CREATE ;
+1 NEW X
+2 SET FDA(44,"+1,",.01)=SDNAME
+3 SET FDA(44,"+1,",1)=SDABR
+4 ;Type
SET FDA(44,"+1,",2)="C"
+5 ;Type Extension pointer to 40.9
SET FDA(44,"+1,",2.1)=$$FIND1^DIC(40.9,,,"CLINIC")
+6 SET FDA(44,"+1,",3.5)=SDDIVSION
+7 SET FDA(44,"+1,",8)=SDSTOPCODE
+8 SET FDA(44,"+1,",9)=SDSERVICE
+9 SET FDA(44,"+1,",10)=SDLOCATION
+10 SET FDA(44,"+1,",20)=SDECHECKIN
+11 SET FDA(44,"+1,",21)=SDPRECHECKIN
+12 SET FDA(44,"+1,",24)=SDINOUTTIME
+13 SET FDA(44,"+1,",30)=SDWORKLOAD
+14 SET FDA(44,"+1,",60)=SDPATNAME
+15 SET FDA(44,"+1,",61)=SDPATSCHED
+16 SET FDA(44,"+1,",62)=SDDISPAPPT
+17 SET FDA(44,"+1,",99)=SDPHONE
+18 SET FDA(44,"+1,",99.1)=SDPHONEEXT
+19 SET FDA(44,"+1,",1912)=SDLENGTHOFAPT
+20 SET FDA(44,"+1,",1913)=SDVARAPTLNG
+21 SET FDA(44,"+1,",1914)=SDSTARTHR
+22 SET FDA(44,"+1,",1916)=SDPRINCLINIC
+23 SET FDA(44,"+1,",1917)=SDINCPERHR
+24 SET FDA(44,"+1,",1918)=SDOVBDAYMAX
+25 SET FDA(44,"+1,",1918.5)=SDSCHEDHOLIDAY
+26 SET FDA(44,"+1,",2000)=SDREQXRAY
+27 SET FDA(44,"+1,",2000.5)=SDREQPROFILE
+28 SET FDA(44,"+1,",2001)=SDALLOWNOSHW
+29 SET FDA(44,"+1,",2002)=SDMAXFUTBOOK
+30 SET FDA(44,"+1,",2500)=SDNOACCESS
+31 SET FDA(44,"+1,",2502)=SDNONCOUNT
+32 SET FDA(44,"+1,",2503)=SDCREDITSTOP
+33 SET FDA(44,"+1,",2504)=SDMEETATFAC
+34 SET FDA(44,"+1,",2507)=SDAPPTTYP
+35 SET FDA(44,"+1,",2508)=SDNOSHOWLET
+36 SET FDA(44,"+1,",2509)=SDPREAPTLET
+37 SET FDA(44,"+1,",2510)=SDCANLET
+38 SET FDA(44,"+1,",2511)=SDAPTCANLET
+39 SET FDA(44,"+1,",2801)=SDPRACTIONER
+40 SET FDA(44,"+1,",2802)=SDINPATMED
+41 QUIT
+42 ;
UPDATE ;
+1 NEW X
+2 SET X=SDIEN
+3 if SDNAME'=""
SET FDA(44,X_",",.01)=SDNAME
+4 if SDABR'=""
SET FDA(44,X_",",1)=SDABR
+5 if SDDIVSION'=""
SET FDA(44,X_",",3.5)=SDDIVSION
+6 if SDSTOPCODE'=""
SET FDA(44,X_",",8)=SDSTOPCODE
+7 if SDSERVICE'=""
SET FDA(44,X_",",9)=SDSERVICE
+8 if SDLOCATION'=""
SET FDA(44,X_",",10)=SDLOCATION
+9 if SDECHECKIN'=""
SET FDA(44,X_",",20)=SDECHECKIN
+10 if SDPRECHECKIN'=""
SET FDA(44,X_",",21)=SDPRECHECKIN
+11 if SDINOUTTIME'=""
SET FDA(44,X_",",24)=SDINOUTTIME
+12 if SDWORKLOAD'=""
SET FDA(44,X_",",30)=SDWORKLOAD
+13 if SDPATNAME'=""
SET FDA(44,X_",",60)=SDPATNAME
+14 if SDPATSCHED'=""
SET FDA(44,X_",",61)=SDPATSCHED
+15 if SDDISPAPPT'=""
SET FDA(44,X_",",62)=SDDISPAPPT
+16 if SDPHONE'=""
SET FDA(44,X_",",99)=SDPHONE
+17 if SDPHONEEXT'=""
SET FDA(44,X_",",99.1)=SDPHONEEXT
+18 if SDLENGTHOFAPT'=""
SET FDA(44,X_",",1912)=SDLENGTHOFAPT
+19 if SDVARAPTLNG'=""
SET FDA(44,X_",",1913)=SDVARAPTLNG
+20 if SDPRINCLINIC'=""
SET FDA(44,X_",",1916)=SDPRINCLINIC
+21 if SDOVBDAYMAX'=""
SET FDA(44,X_",",1918)=SDOVBDAYMAX
+22 if SDREQXRAY'=""
SET FDA(44,X_",",2000)=SDREQXRAY
+23 if SDREQPROFILE'=""
SET FDA(44,X_",",2000.5)=SDREQPROFILE
+24 if SDALLOWNOSHW'=""
SET FDA(44,X_",",2001)=SDALLOWNOSHW
+25 if SDMAXFUTBOOK'=""
SET FDA(44,X_",",2002)=SDMAXFUTBOOK
+26 if SDNOACCESS'=""
SET FDA(44,X_",",2500)=SDNOACCESS
+27 if SDNONCOUNT'=""
SET FDA(44,X_",",2502)=SDNONCOUNT
+28 if SDCREDITSTOP'=""
SET FDA(44,X_",",2503)=SDCREDITSTOP
+29 if SDMEETATFAC'=""
SET FDA(44,X_",",2504)=SDMEETATFAC
+30 if SDAPPTTYP'=""
SET FDA(44,X_",",2507)=SDAPPTTYP
+31 if SDNOSHOWLET'=""
SET FDA(44,X_",",2508)=SDNOSHOWLET
+32 if SDPREAPTLET'=""
SET FDA(44,X_",",2509)=SDPREAPTLET
+33 if SDCANLET'=""
SET FDA(44,X_",",2510)=SDCANLET
+34 if SDAPTCANLET'=""
SET FDA(44,X_",",2511)=SDAPTCANLET
+35 if SDPRACTIONER'=""
SET FDA(44,X_",",2801)=SDPRACTIONER
+36 if SDINPATMED'=""
SET FDA(44,X_",",2802)=SDINPATMED
+37 QUIT
