SDESCLINICSET.m

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 ---SDESCLINICSET   18027     printed  Apr 23, 2025@19:10:48                                                                                                                                                                                              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      ;