Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: SDESCLINICSET

SDESCLINICSET.m

Go to the documentation of this file.
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