SDEC32 ;ALB/SAT,DMR - VISTA SCHEDULING RPCS ;JUL 26, 2017
;;5.3;Scheduling;**627,643,642,658,665,672,679,781,796,797**;Aug 13, 1993;Build 8
;;Per VHA Directive 6402, this routine should not be modified
Q
;
;
ERROR ;
D ERR("VistA Error")
Q
;
ERR(SDECERR) ;Error processing
S SDECI=SDECI+1
S ^TMP("SDEC",$J,SDECI)=$C(31)
Q
;
HOSPLOC(SDECY,SDECP,MAXREC,LSUB) ;return HOSPITAL LOCATIONs
;HOSPLOC(SDECY) external parameter tag is in SDEC
;INPUT:
; SDECP - (optional) Partial name text
; MAXREC - (optional) Max number of records to return
; LSUB - (optional) subscripts from last call to pick up where left off
;RETURN:
;Global Array in which each array entry
;contains HOSPITAL LOCATION data separated by ^:
; 1. HOSPITAL_LOCATION_ID
; 2. HOSPITAL_LOCATION
; 3. DEFAULT_PROVIDER
; 4. STOP_CODE_NUMBER
; 5. INACTIVATE_DATE
; 6. REACTIVATE_DATE
; 7. LASTSUB
N SDECI,SDECIEN,SDECNOD,SDECNOD1,SDECNAM,SDECINA,SDECREA,SDECSCOD
N SDECIEN1,SDECPRV,SDDUP,SDNAM
N LASTSUB,X
K ^TMP("SDEC",$J)
S SDECY="^TMP(""SDEC"","_$J_")"
S SDECI=0
S ^TMP("SDEC",$J,SDECI)="I00020HOSPITAL_LOCATION_ID^T00040HOSPITAL_LOCATION^T00030DEFAULT_PROVIDER^T00030STOP_CODE_NUMBER^D00020INACTIVATE_DATE^D00020REACTIVATE_DATE^T00030LASTSUB"_$C(30)
;
S SDECP=$G(SDECP)
S MAXREC=+$G(MAXREC)
S LSUB=$G(LSUB)
S:LSUB="" SDECNAM=$S(SDECP'="":$$GETSUB^SDEC56(SDECP),1:"")
S:LSUB'="" SDECNAM=$$GETSUB^SDEC56($P(LSUB,"|",1))
F S SDECNAM=$O(^SC("B",SDECNAM)) Q:(SDECP'="")&(SDECNAM'[SDECP) Q:SDECNAM="" D Q:(+MAXREC)&(SDECI'<MAXREC)
. S SDECIEN=$S(LSUB'="":$P(LSUB,"|",2),1:0) S LSUB="" F S SDECIEN=$O(^SC("B",SDECNAM,SDECIEN)) Q:SDECIEN'>0 D Q:(+MAXREC)&(SDECI'<MAXREC)
.. Q:'+SDECIEN>0
.. Q:'$D(^SC(+SDECIEN,0))
.. Q:$$INACTIVE(+SDECIEN)
.. Q:+$$GET1^DIQ(44,SDECIEN_",",50.01,"I")=1 ;OOS?
.. S SDECINA=$$GET1^DIQ(44,SDECIEN_",",2505) ;INACTIVATE
.. S SDECREA=$$GET1^DIQ(44,SDECIEN_",",2506) ;REACTIVATE
.. S SDECNOD=^SC(SDECIEN,0)
.. Q:$D(SDDUP(+SDECIEN))
.. S SDDUP(+SDECIEN)=""
.. S SDNAM=$P(SDECNOD,U)
.. S SDECSCOD=$$GET1^DIQ(44,SDECIEN_",",8) ;STOP CODE
.. ;Calculate default provider
.. S SDECPRV=""
.. I $D(^SC(SDECIEN,"PR")) D
... S SDECIEN1=0 F S SDECIEN1=$O(^SC(SDECIEN,"PR",SDECIEN1)) Q:'+SDECIEN1 Q:SDECPRV]"" D
.... S SDECNOD1=$G(^SC(SDECIEN,"PR",SDECIEN1,0))
.... S:$P(SDECNOD1,U,2)="1" SDECPRV=$$GET1^DIQ(200,$P(SDECNOD1,U),.01)
.... Q
... Q
.. S LASTSUB=SDECNAM_"|"_SDECIEN
.. S SDECI=SDECI+1
.. S ^TMP("SDEC",$J,SDECI)=SDECIEN_U_SDNAM_U_SDECPRV_U_SDECSCOD_U_SDECINA_U_SDECREA_U_LASTSUB_$C(30)
.. Q
I SDECNAM="",SDECIEN="" S $P(^TMP("SDEC",$J,SDECI),U,7)="" ;clear lastsub for last entry if finished
S ^TMP("SDEC",$J,SDECI)=^TMP("SDEC",$J,SDECI)_$C(31)
K SDDUP
Q
;
CLINSET(SDECY,SDNOSLOT,SDIENS,SDECP,SDNOLET,MAXREC) ;Returns CLINIC SETUP PARAMETERS for clinics that are active in the HOSPITAL LOCATION file
;CLINSET(SDECY,SDNOSLOT,SDIENS,SDECP,SDNOLET) external parameter tag is in SDEC
;INPUT:
; SDNOSLOT - no slots flag - 0=return availability 1=do not return availability
; SDIENS - IENs for individual hospital locations separated by pipes
; SDNOLET - flag to include clinics with no Recall Letter defined
; in RECALL REMINDERS LETTERS file
; 0 = yes (include all clinics including those with no Recall Letter
; defined) [default]
; 1 = no (only return clinics with a Recall Letter
; defined)
;Returns CLINIC SETUP PARAMETERS file entries for clinics which
;are active in ^SC (#44)
;MGH Added SDIENS as input parameter to for hospital location IENs
;MGH Added SDECP for partial name lookup
;RETURN
; Global Array in which each array entry contains the following Clinic data separated by ^:
; 1. HOSPITAL_LOCATION_ID
; 2. HOSPITAL_LOCATION
; 3. CREATE_VISIT
; 4. VISIT_SERVICE_CATEGORY
; 5. MULTIPLE_CLINIC_CODES_USED?
; 6. VISIT_PROVIDER_REQUIRED
; 7. GENERATE_PCCPLUS_FORMS?
; 8. MAX_OVERBOOKS
; 9. SDECDAT
;10. SDECDATN
;11. APPTLEN - 1912 Appointment Length Numeric 10-240
;12. VAPPTLEN
;13. SLOTS
;14. PRIVUSERPRESENT_BOOL
;15. PROTECTED
;16. HOUR_DISPLAY_BEGIN - 1914 Hour Clinic Display Begins
;17. DISPLAY_INCREMENTS - 1917 Display increments per hour
; 1=60-MIN
; 2=30-MIN
; 4=15-MIN
; 3=20-MIN
; 6=10-MIN
;18. HOLIDAYS - 1918.5 Schedule on Holidays? Y=YES
;19. SPECIAL - 1910 SPECIAL INSTRUCTIONS separated by $C(13,10)
;20. CLINIC_STOP - 8 Stop code Number pointer to CLINIC STOP in file 40.7
;21. ABBREVIATION - 1 Abbrevation
;22. not used ??
;23. DEFAULT_VIEW - Scheduling default view
;24. VVC Indicator - Inicator if this clinic is considered a VVC clinic (1=Yes 0=No)
N SDA,SDAPLEN,SDAR,SDDATA,SDF,SDFIELDS,SDI,SDJ,SDK,SDSLOTS,SDVAPL,SDECI,SDECIEN,SDECNOD,SDECNAM,SDECINA,SDECREA,SDTMP ;alb/sat 665 - add SDF
N SDECCRV,SDECDAT,SDECDATN,SDECVSC,SDECMULT,SDECREQ,SDECPCC,SDECMOB,SDECHPRV,SDECPROT,SDECNAM,SDCNT,SDL,SDMAX ;alb/sat 665 - add vars
N SDARR1,SDREF,SDXT,SDV ;alb/sat 672
K ^TMP("SDEC",$J)
S (SDCNT,SDMAX)=0
S SDF=""
S SDV="" ;alb/sat 672
S SDECY="^TMP(""SDEC"","_$J_")"
S SDECI=0
; 1 2 3 4
S SDTMP="I00020HOSPITAL_LOCATION_ID^T00040HOSPITAL_LOCATION^T00030CREATE_VISIT^T00030VISIT_SERVICE_CATEGORY"
; 5 6 7
S SDTMP=SDTMP_"^T00030MULTIPLE_CLINIC_CODES_USED?^T00030VISIT_PROVIDER_REQUIRED^T00030GENERATE_PCCPLUS_FORMS?"
; 8 9 10 11 12 13 14
S SDTMP=SDTMP_"^T00030MAX_OVERBOOKS^T00030SDECDAT^T00030SDECDATN^T00030APPTLEN^T00030VAPPTLEN^T00030SLOTS^B00001PRIVUSERPRESENT_BOOL"
; 15 16 17 18
S SDTMP=SDTMP_"^B00001PROTECTED^T00030HOUR_DISPLAY_BEGIN^T00030DISPLAY_INCREMENTS^T00030HOLIDAYS^T00030SPECIAL^T00030CLINIC_STOP"
; 21 22 23
S SDTMP=SDTMP_"^T00030ABBR^T00030MORE^T00030DEFAULT_VIEW" ;alb/sat 672 - add DEFAULT_VIEW
; 24
S SDTMP=SDTMP_"^T00030VVC_CLINIC" ; VVC_Indicator
S ^TMP("SDEC",$J,SDECI)=SDTMP_$C(30)
;
S (SDECDAT,SDECDATN)=""
S SDNOSLOT=$G(SDNOSLOT)
S SDNOLET=$G(SDNOLET)
S MAXREC=$G(MAXREC,50)
;MGH change made for individual locations
I $G(SDIENS) D
.F SDK=1:1:$L(SDIENS,"|") D
..S SDECIEN=$P(SDIENS,"|",SDK)
..D PROCESS(SDECIEN)
;MGH change made for partial name lookup
I $G(SDECP)'="" D
.;alb/sat 672 - begin modification; separate string and numeric lookup
.S (SDECNAM,SDXT)=$$GETSUB^SDECU(SDECP)
.;abbreviation as string
.S SDF="ABBRSTR" D
..S SDREF="C" D PART Q
.;abbreviation as numeric
.S SDF="ABBRNUM",SDECNAM=SDXT_" " D
..S SDREF="C" D PART Q
.;name as string
.S SDF="FULLSTR",SDECNAM=SDXT D
..S SDREF="B" D PART Q
.;name as numeric
.S SDF="FULLNUM",SDECNAM=SDXT_" " D
..S SDREF="B" D PART Q
.;alb/sat 672 - end modification; separate string and numeric lookup
I $G(SDIENS)=""&($G(SDECP)="") S SDECIEN=0 F S SDECIEN=$O(^SC(SDECIEN)) Q:SDECIEN'>0 D
.D PROCESS(SDECIEN)
S SDL=-1 F S SDL=$O(SDAR(SDL)) Q:SDL="" D
.S SDI="" F S SDI=$O(SDAR(SDL,SDI)) Q:SDI="" D
..S SDJ="" F S SDJ=$O(SDAR(SDL,SDI,SDJ)) Q:SDJ="" D
...S SDTMP=SDAR(SDL,SDI,SDJ)
...S $P(SDTMP,U,22)=$S(+SDMAX:1,1:0)
...S SDECI=SDECI+1
...S ^TMP("SDEC",$J,SDECI)=SDTMP_$C(30)
S ^TMP("SDEC",$J,SDECI)=^TMP("SDEC",$J,SDECI)_$C(31)
Q
PART ;partial name lookup ;alb/sat 672
Q:SDREF=""
F S SDECNAM=$O(^SC(SDREF,SDECNAM)) Q:SDECNAM'[SDECP D I SDCNT'<MAXREC S SDECNAM=$O(^SC(SDREF,SDECNAM)) S SDMAX=$S(+SDMAX:1,SDECNAM[SDECP:1,1:0) Q ;alb/sat 658 - abbreviation lookup if characters length 7 or less
.S SDECIEN=0 F S SDECIEN=$O(^SC(SDREF,SDECNAM,SDECIEN)) Q:SDECIEN="" D PROCESS(SDECIEN) I SDCNT'<MAXREC S SDMAX=+$O(^SC(SDREF,SDECNAM,SDECIEN)) Q ;alb/sat 665 loop thru all entries
Q
PROCESS(SDECIEN) ;Process an individual clinic
;MGH broke this out to do all locations or individual ones
N SDECABR,SDECNAM,SDI,SDI1,SDDI,SDH,SDHDB,SDSP,SDSTOP
N SDVVC,SDCRSTOP
Q:'$D(^SC(+SDECIEN,0))
;Q:$$INACTIVE(+SDECIEN) ;SD,796
I SDNOLET,'$O(^SD(403.52,"B",+SDECIEN,0)) Q
D RESCLIN1^SDEC01B(SDECIEN)
S SDSLOTS=""
K SDDATA,SDMSG
S SDFIELDS=".01;1;2;8;50.01;1912;1913;1914;1917;1918;1918.5"_$S(SDNOSLOT:"",1:";1920*")_";2503;2505;2506;2507" ;alb/sat 665 - add abbreviation
D GETS^DIQ(44,SDECIEN_",",SDFIELDS,"IE","SDDATA","SDMSG")
Q:$G(SDDATA(44,SDECIEN_",",2,"I"))'="C"
Q:+$G(SDDATA(44,SDECIEN_",",50.01,"I"))=1 ;OOS?
Q:$D(SDARR1(SDECIEN)) ;alb/sat 672 - checking for duplicates
S SDARR1(SDECIEN)="" ;alb/sat 672 - checking for duplicates
S SDA="SDDATA(44,"""_SDECIEN_","")"
S SDAPLEN=@SDA@(1912,"E") ;length of appointment
S SDVAPL=@SDA@(1913,"I") ;variable appointment length V means yes
S SDHDB=@SDA@(1914,"E") ;hour clinic display begins
S:SDHDB="" SDHDB=8
S SDDI=@SDA@(1917,"I") ;display increments per hour
S SDECINA=@SDA@(2505,"E") ;INACTIVATE
S SDECREA=@SDA@(2506,"E") ;REACTIVATE
S SDECDAT=@SDA@(2507,"I") ;DEFAULT APPOINTMENT TYPE ien
S SDECDATN=@SDA@(2507,"E") ;DEFAULT APPOINTMENT TYPE name
S SDSTOP=@SDA@(8,"I") ;STOP CODE NUMBER
S SDECNAM=@SDA@(.01,"E")
S SDECABR=@SDA@(1,"E") ;alb/sat 665
S SDECNAM=$S((SDF["ABBR")&(@SDA@(1,"E")'=""):@SDA@(1,"E")_" ",1:"")_SDECNAM ;alb/sat 665 - include abbr in name if found by C xref
S SDECMOB=@SDA@(1918,"E")
S SDH=@SDA@(1918.5,"I")
S SDECCRV=1 ;$$GET1^DIQ(9009017.2,SDECIEN_",",.09) ;Create Visit at Check-In?
S SDECVSC="" ;$$GET1^DIQ(9009017.2,SDECIEN_",",.12) ;Visit Service Category
S SDECMULT=1 ;$$GET1^DIQ(9009017.2,SDECIEN_",",.13) ;Multiple Clinic codes used?
S SDECREQ=1 ;$$GET1^DIQ(9009017.2,SDECIEN_",",.14) ;Visit Provider Required
S SDECPCC=0 ;$$GET1^DIQ(9009017.2,SDECIEN_",",.15) ;Generate PCCPlus Forms?
S:'SDNOSLOT SDSLOTS=$$GETSLOTS(.SDDATA)
S SDECHPRV=$O(^SC(+SDECIEN,"SDPRIV",0))>0
S SDECPROT=$G(^SC(+SDECIEN,"SDPROT"))="Y"
S SDSP="" S SDI=0 F S SDI=$O(^SC(+SDECIEN,"SI",SDI)) Q:SDI'>0 S SDI1=$G(^SC(+SDECIEN,"SI",SDI,0)) S:SDI1'="" SDSP=$S(SDSP'="":SDSP_$C(13,10),1:"")_SDI1
S:SDECNAM'="" SDV=$$GET^XPAR("PKG.SCHEDULING","SDEC VS GUI CLINIC VIEW",SDECNAM,"B") ;alb/sat 672
S SDV=$S(SDV'="":$P(SDV,U,1),1:"W") ;alb/sat 672
S SDVVC=0
S SDCRSTOP=@SDA@(2503,"I") ;CREDIT STOP CODE NUMBER
I SDSTOP S SDVVC=$$VVCSTPCD(SDSTOP)
I 'SDVVC,SDCRSTOP S SDVVC=$$VVCSTPCD(SDCRSTOP)
; 1 2 3 4 5 6 7 8
S SDTMP=SDECIEN_U_SDECNAM_U_SDECCRV_U_SDECVSC_U_SDECMULT_U_SDECREQ_U_SDECPCC_U_SDECMOB
; 9 10 11 12 13 14 15
S SDTMP=SDTMP_U_SDECDAT_U_SDECDATN_U_+SDAPLEN_U_SDVAPL_U_SDSLOTS_U_SDECHPRV_U_SDECPROT
; 16 17 18 19 20 21 22 23
S SDTMP=SDTMP_U_SDHDB_U_SDDI_U_SDH_U_SDSP_U_SDSTOP_U_SDECABR_U_U_SDV ;alb/sat 672 - add SDV
; 24
S SDTMP=SDTMP_U_SDVVC ; ??? - add SDVVC
S SDAR(SDF["FULL",SDECNAM,SDECIEN)=SDTMP
S SDCNT=SDCNT+1
Q
CHK(SDECP,SDECIEN) ;alb/sat 665 - stop if 'this' record found in abbreviations ;alb/sat 672 - removed
Q
N FND,SDR,SDX
S FND=0
S SDX=$$GETSUB^SDEC56(SDECP)
F S SDX=$O(^SC("C",SDX)) Q:SDX="" Q:SDX'[SDECP D Q:+FND
.S SDR=0 F S SDR=$O(^SC("C",SDX,SDR)) Q:'+SDR S FND=SDR=SDECIEN Q:+FND
Q FND
;
;
GETSLOTS(SDDATA) ;get slots - NUMBER OF PATIENTS in the AVAILABILITY multiple of file 44
;INPUT:
; SDDATA - array from GETS^DIQ against file 44 above to collect timeslots from
N SDI,SDDT,SDSLOTS
S SDSLOTS=""
S SDI="" F S SDI=$O(SDDATA(44.004,SDI)) Q:SDI="" D
.S SDDT=$P(SDI,",",2) ;get date
.S SDDT=SDDT_"."_SDDATA(44.004,SDI,.01,"I") ;get time
.S SDDT=$$FMTE^XLFDT(SDDT)
.S SDSLOTS=$S(SDSLOTS'="":SDSLOTS_"|",1:"")_SDDT_";;"_SDDATA(44.004,SDI,1,"E")
Q SDSLOTS
;
INACTIVE(SDCL,SDDT) ;determine if clinic is active
; X=0=ACTIVE
; X=1=INACTIVE
N SDNODI,N21,N25,X
S SDDT=$G(SDDT) I SDDT="" S SDDT=DT
S SDDT=$P(SDDT,".",1)
S X=1
S SDNODI=$G(^SC(SDCL,"I"))
Q:SDNODI="" 0
S N21=$P(SDNODI,U,1) ;inactive date/time
S N25=$P(SDNODI,U,2) ;reactive date/time
I (N21="") S X=0 Q X
I (N21'="")&(N21>SDDT) S X=0 Q X
I (N25'="")&(N25'>SDDT) S X=0 Q X
Q X
;
PRIV(SDECY,CLINIEN,USER) ;IS this USER in the PRIVILEGED USER multiple for the clinic
;INPUT:
; CLINIEN - pointer to HOSPITAL LOCATION file 44
; USER - pointer to NEW PERSON file 200
;RETURN:
; A single boolean entry indicating that the USER is a PRIVILEGED USER for the clinic.
; RETURNCODE - 0=NO; 1=YES; -1=error
; MESSAGE
N SDRET
S SDECY="^TMP(""SDEC32"","_$J_",""PRIV"")"
K @SDECY
S @SDECY@(0)="T00030RETURNCODE^MESSAGE"_$C(30)
S CLINIEN=$G(CLINIEN)
I (CLINIEN="")!('$D(^SC(CLINIEN,0))) S @SDECY@(1)="-1^Invalid clinic ID."_$C(30,31) Q
S USER=$G(USER)
I (USER="")!('$D(^VA(200,USER,0))) S @SDECY@(1)="-1^Invalid user ID."_$C(30,31) Q
S SDRET=$D(^SC(CLINIEN,"SDPRIV",USER,0))
S $P(SDRET,U,2)=$S(SDRET=1:"YES",1:"NO")
S @SDECY@(1)=SDRET_$C(30,31)
Q
;
BOOKHLDY(SDECY,SDECCL) ; Returns can book on holiday flag for a clinic. 12/1/17 wtc 679
;
; Returns value of field 1918.5 in file #44
;
; SDECY = return value
; SDECCL = pointer to file #44
;
S SDECY="" ;
Q:$G(SDECCL)="" ;
S SDECY=$P($G(^SC(SDECCL,"SL")),"^",8) ;
Q ;
;
VVCSTPCD(STOPCD) ;
; Called from PROCES tag above
;
;Input:
; STOPCD - a stop code
;
;Return:
; 1 = Stop code is found in the SDEC SETTING file (#409.98) field 7 VVC STOP CODE
Q:'$G(STOPCD)
N RETURN,STOP
;
S RETURN=0
S STOP="" S STOP=$$GET1^DIQ(40.7,STOPCD,1)
I STOP>0 D
.I $D(^SDEC(409.98,1,3,"B",STOP)) S RETURN=1
Q RETURN
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDEC32 14328 printed Oct 16, 2024@18:51:02 Page 2
SDEC32 ;ALB/SAT,DMR - VISTA SCHEDULING RPCS ;JUL 26, 2017
+1 ;;5.3;Scheduling;**627,643,642,658,665,672,679,781,796,797**;Aug 13, 1993;Build 8
+2 ;;Per VHA Directive 6402, this routine should not be modified
+3 QUIT
+4 ;
+5 ;
ERROR ;
+1 DO ERR("VistA Error")
+2 QUIT
+3 ;
ERR(SDECERR) ;Error processing
+1 SET SDECI=SDECI+1
+2 SET ^TMP("SDEC",$JOB,SDECI)=$CHAR(31)
+3 QUIT
+4 ;
HOSPLOC(SDECY,SDECP,MAXREC,LSUB) ;return HOSPITAL LOCATIONs
+1 ;HOSPLOC(SDECY) external parameter tag is in SDEC
+2 ;INPUT:
+3 ; SDECP - (optional) Partial name text
+4 ; MAXREC - (optional) Max number of records to return
+5 ; LSUB - (optional) subscripts from last call to pick up where left off
+6 ;RETURN:
+7 ;Global Array in which each array entry
+8 ;contains HOSPITAL LOCATION data separated by ^:
+9 ; 1. HOSPITAL_LOCATION_ID
+10 ; 2. HOSPITAL_LOCATION
+11 ; 3. DEFAULT_PROVIDER
+12 ; 4. STOP_CODE_NUMBER
+13 ; 5. INACTIVATE_DATE
+14 ; 6. REACTIVATE_DATE
+15 ; 7. LASTSUB
+16 NEW SDECI,SDECIEN,SDECNOD,SDECNOD1,SDECNAM,SDECINA,SDECREA,SDECSCOD
+17 NEW SDECIEN1,SDECPRV,SDDUP,SDNAM
+18 NEW LASTSUB,X
+19 KILL ^TMP("SDEC",$JOB)
+20 SET SDECY="^TMP(""SDEC"","_$JOB_")"
+21 SET SDECI=0
+22 SET ^TMP("SDEC",$JOB,SDECI)="I00020HOSPITAL_LOCATION_ID^T00040HOSPITAL_LOCATION^T00030DEFAULT_PROVIDER^T00030STOP_CODE_NUMBER^D00020INACTIVATE_DATE^D00020REACTIVATE_DATE^T00030LASTSUB"_$CHAR(30)
+23 ;
+24 SET SDECP=$GET(SDECP)
+25 SET MAXREC=+$GET(MAXREC)
+26 SET LSUB=$GET(LSUB)
+27 if LSUB=""
SET SDECNAM=$SELECT(SDECP'="":$$GETSUB^SDEC56(SDECP),1:"")
+28 if LSUB'=""
SET SDECNAM=$$GETSUB^SDEC56($PIECE(LSUB,"|",1))
+29 FOR
SET SDECNAM=$ORDER(^SC("B",SDECNAM))
if (SDECP'="")&(SDECNAM'[SDECP)
QUIT
if SDECNAM=""
QUIT
Begin DoDot:1
+30 SET SDECIEN=$SELECT(LSUB'="":$PIECE(LSUB,"|",2),1:0)
SET LSUB=""
FOR
SET SDECIEN=$ORDER(^SC("B",SDECNAM,SDECIEN))
if SDECIEN'>0
QUIT
Begin DoDot:2
+31 if '+SDECIEN>0
QUIT
+32 if '$DATA(^SC(+SDECIEN,0))
QUIT
+33 if $$INACTIVE(+SDECIEN)
QUIT
+34 ;OOS?
if +$$GET1^DIQ(44,SDECIEN_",",50.01,"I")=1
QUIT
+35 ;INACTIVATE
SET SDECINA=$$GET1^DIQ(44,SDECIEN_",",2505)
+36 ;REACTIVATE
SET SDECREA=$$GET1^DIQ(44,SDECIEN_",",2506)
+37 SET SDECNOD=^SC(SDECIEN,0)
+38 if $DATA(SDDUP(+SDECIEN))
QUIT
+39 SET SDDUP(+SDECIEN)=""
+40 SET SDNAM=$PIECE(SDECNOD,U)
+41 ;STOP CODE
SET SDECSCOD=$$GET1^DIQ(44,SDECIEN_",",8)
+42 ;Calculate default provider
+43 SET SDECPRV=""
+44 IF $DATA(^SC(SDECIEN,"PR"))
Begin DoDot:3
+45 SET SDECIEN1=0
FOR
SET SDECIEN1=$ORDER(^SC(SDECIEN,"PR",SDECIEN1))
if '+SDECIEN1
QUIT
if SDECPRV]""
QUIT
Begin DoDot:4
+46 SET SDECNOD1=$GET(^SC(SDECIEN,"PR",SDECIEN1,0))
+47 if $PIECE(SDECNOD1,U,2)="1"
SET SDECPRV=$$GET1^DIQ(200,$PIECE(SDECNOD1,U),.01)
+48 QUIT
End DoDot:4
+49 QUIT
End DoDot:3
+50 SET LASTSUB=SDECNAM_"|"_SDECIEN
+51 SET SDECI=SDECI+1
+52 SET ^TMP("SDEC",$JOB,SDECI)=SDECIEN_U_SDNAM_U_SDECPRV_U_SDECSCOD_U_SDECINA_U_SDECREA_U_LASTSUB_$CHAR(30)
+53 QUIT
End DoDot:2
if (+MAXREC)&(SDECI'<MAXREC)
QUIT
End DoDot:1
if (+MAXREC)&(SDECI'<MAXREC)
QUIT
+54 ;clear lastsub for last entry if finished
IF SDECNAM=""
IF SDECIEN=""
SET $PIECE(^TMP("SDEC",$JOB,SDECI),U,7)=""
+55 SET ^TMP("SDEC",$JOB,SDECI)=^TMP("SDEC",$JOB,SDECI)_$CHAR(31)
+56 KILL SDDUP
+57 QUIT
+58 ;
CLINSET(SDECY,SDNOSLOT,SDIENS,SDECP,SDNOLET,MAXREC) ;Returns CLINIC SETUP PARAMETERS for clinics that are active in the HOSPITAL LOCATION file
+1 ;CLINSET(SDECY,SDNOSLOT,SDIENS,SDECP,SDNOLET) external parameter tag is in SDEC
+2 ;INPUT:
+3 ; SDNOSLOT - no slots flag - 0=return availability 1=do not return availability
+4 ; SDIENS - IENs for individual hospital locations separated by pipes
+5 ; SDNOLET - flag to include clinics with no Recall Letter defined
+6 ; in RECALL REMINDERS LETTERS file
+7 ; 0 = yes (include all clinics including those with no Recall Letter
+8 ; defined) [default]
+9 ; 1 = no (only return clinics with a Recall Letter
+10 ; defined)
+11 ;Returns CLINIC SETUP PARAMETERS file entries for clinics which
+12 ;are active in ^SC (#44)
+13 ;MGH Added SDIENS as input parameter to for hospital location IENs
+14 ;MGH Added SDECP for partial name lookup
+15 ;RETURN
+16 ; Global Array in which each array entry contains the following Clinic data separated by ^:
+17 ; 1. HOSPITAL_LOCATION_ID
+18 ; 2. HOSPITAL_LOCATION
+19 ; 3. CREATE_VISIT
+20 ; 4. VISIT_SERVICE_CATEGORY
+21 ; 5. MULTIPLE_CLINIC_CODES_USED?
+22 ; 6. VISIT_PROVIDER_REQUIRED
+23 ; 7. GENERATE_PCCPLUS_FORMS?
+24 ; 8. MAX_OVERBOOKS
+25 ; 9. SDECDAT
+26 ;10. SDECDATN
+27 ;11. APPTLEN - 1912 Appointment Length Numeric 10-240
+28 ;12. VAPPTLEN
+29 ;13. SLOTS
+30 ;14. PRIVUSERPRESENT_BOOL
+31 ;15. PROTECTED
+32 ;16. HOUR_DISPLAY_BEGIN - 1914 Hour Clinic Display Begins
+33 ;17. DISPLAY_INCREMENTS - 1917 Display increments per hour
+34 ; 1=60-MIN
+35 ; 2=30-MIN
+36 ; 4=15-MIN
+37 ; 3=20-MIN
+38 ; 6=10-MIN
+39 ;18. HOLIDAYS - 1918.5 Schedule on Holidays? Y=YES
+40 ;19. SPECIAL - 1910 SPECIAL INSTRUCTIONS separated by $C(13,10)
+41 ;20. CLINIC_STOP - 8 Stop code Number pointer to CLINIC STOP in file 40.7
+42 ;21. ABBREVIATION - 1 Abbrevation
+43 ;22. not used ??
+44 ;23. DEFAULT_VIEW - Scheduling default view
+45 ;24. VVC Indicator - Inicator if this clinic is considered a VVC clinic (1=Yes 0=No)
+46 ;alb/sat 665 - add SDF
NEW SDA,SDAPLEN,SDAR,SDDATA,SDF,SDFIELDS,SDI,SDJ,SDK,SDSLOTS,SDVAPL,SDECI,SDECIEN,SDECNOD,SDECNAM,SDECINA,SDECREA,SDTMP
+47 ;alb/sat 665 - add vars
NEW SDECCRV,SDECDAT,SDECDATN,SDECVSC,SDECMULT,SDECREQ,SDECPCC,SDECMOB,SDECHPRV,SDECPROT,SDECNAM,SDCNT,SDL,SDMAX
+48 ;alb/sat 672
NEW SDARR1,SDREF,SDXT,SDV
+49 KILL ^TMP("SDEC",$JOB)
+50 SET (SDCNT,SDMAX)=0
+51 SET SDF=""
+52 ;alb/sat 672
SET SDV=""
+53 SET SDECY="^TMP(""SDEC"","_$JOB_")"
+54 SET SDECI=0
+55 ; 1 2 3 4
+56 SET SDTMP="I00020HOSPITAL_LOCATION_ID^T00040HOSPITAL_LOCATION^T00030CREATE_VISIT^T00030VISIT_SERVICE_CATEGORY"
+57 ; 5 6 7
+58 SET SDTMP=SDTMP_"^T00030MULTIPLE_CLINIC_CODES_USED?^T00030VISIT_PROVIDER_REQUIRED^T00030GENERATE_PCCPLUS_FORMS?"
+59 ; 8 9 10 11 12 13 14
+60 SET SDTMP=SDTMP_"^T00030MAX_OVERBOOKS^T00030SDECDAT^T00030SDECDATN^T00030APPTLEN^T00030VAPPTLEN^T00030SLOTS^B00001PRIVUSERPRESENT_BOOL"
+61 ; 15 16 17 18
+62 SET SDTMP=SDTMP_"^B00001PROTECTED^T00030HOUR_DISPLAY_BEGIN^T00030DISPLAY_INCREMENTS^T00030HOLIDAYS^T00030SPECIAL^T00030CLINIC_STOP"
+63 ; 21 22 23
+64 ;alb/sat 672 - add DEFAULT_VIEW
SET SDTMP=SDTMP_"^T00030ABBR^T00030MORE^T00030DEFAULT_VIEW"
+65 ; 24
+66 ; VVC_Indicator
SET SDTMP=SDTMP_"^T00030VVC_CLINIC"
+67 SET ^TMP("SDEC",$JOB,SDECI)=SDTMP_$CHAR(30)
+68 ;
+69 SET (SDECDAT,SDECDATN)=""
+70 SET SDNOSLOT=$GET(SDNOSLOT)
+71 SET SDNOLET=$GET(SDNOLET)
+72 SET MAXREC=$GET(MAXREC,50)
+73 ;MGH change made for individual locations
+74 IF $GET(SDIENS)
Begin DoDot:1
+75 FOR SDK=1:1:$LENGTH(SDIENS,"|")
Begin DoDot:2
+76 SET SDECIEN=$PIECE(SDIENS,"|",SDK)
+77 DO PROCESS(SDECIEN)
End DoDot:2
End DoDot:1
+78 ;MGH change made for partial name lookup
+79 IF $GET(SDECP)'=""
Begin DoDot:1
+80 ;alb/sat 672 - begin modification; separate string and numeric lookup
+81 SET (SDECNAM,SDXT)=$$GETSUB^SDECU(SDECP)
+82 ;abbreviation as string
+83 SET SDF="ABBRSTR"
Begin DoDot:2
+84 SET SDREF="C"
DO PART
QUIT
End DoDot:2
+85 ;abbreviation as numeric
+86 SET SDF="ABBRNUM"
SET SDECNAM=SDXT_" "
Begin DoDot:2
+87 SET SDREF="C"
DO PART
QUIT
End DoDot:2
+88 ;name as string
+89 SET SDF="FULLSTR"
SET SDECNAM=SDXT
Begin DoDot:2
+90 SET SDREF="B"
DO PART
QUIT
End DoDot:2
+91 ;name as numeric
+92 SET SDF="FULLNUM"
SET SDECNAM=SDXT_" "
Begin DoDot:2
+93 SET SDREF="B"
DO PART
QUIT
End DoDot:2
+94 ;alb/sat 672 - end modification; separate string and numeric lookup
End DoDot:1
+95 IF $GET(SDIENS)=""&($GET(SDECP)="")
SET SDECIEN=0
FOR
SET SDECIEN=$ORDER(^SC(SDECIEN))
if SDECIEN'>0
QUIT
Begin DoDot:1
+96 DO PROCESS(SDECIEN)
End DoDot:1
+97 SET SDL=-1
FOR
SET SDL=$ORDER(SDAR(SDL))
if SDL=""
QUIT
Begin DoDot:1
+98 SET SDI=""
FOR
SET SDI=$ORDER(SDAR(SDL,SDI))
if SDI=""
QUIT
Begin DoDot:2
+99 SET SDJ=""
FOR
SET SDJ=$ORDER(SDAR(SDL,SDI,SDJ))
if SDJ=""
QUIT
Begin DoDot:3
+100 SET SDTMP=SDAR(SDL,SDI,SDJ)
+101 SET $PIECE(SDTMP,U,22)=$SELECT(+SDMAX:1,1:0)
+102 SET SDECI=SDECI+1
+103 SET ^TMP("SDEC",$JOB,SDECI)=SDTMP_$CHAR(30)
End DoDot:3
End DoDot:2
End DoDot:1
+104 SET ^TMP("SDEC",$JOB,SDECI)=^TMP("SDEC",$JOB,SDECI)_$CHAR(31)
+105 QUIT
PART ;partial name lookup ;alb/sat 672
+1 if SDREF=""
QUIT
+2 ;alb/sat 658 - abbreviation lookup if characters length 7 or less
FOR
SET SDECNAM=$ORDER(^SC(SDREF,SDECNAM))
if SDECNAM'[SDECP
QUIT
Begin DoDot:1
+3 ;alb/sat 665 loop thru all entries
SET SDECIEN=0
FOR
SET SDECIEN=$ORDER(^SC(SDREF,SDECNAM,SDECIEN))
if SDECIEN=""
QUIT
DO PROCESS(SDECIEN)
IF SDCNT'<MAXREC
SET SDMAX=+$ORDER(^SC(SDREF,SDECNAM,SDECIEN))
QUIT
End DoDot:1
IF SDCNT'<MAXREC
SET SDECNAM=$ORDER(^SC(SDREF,SDECNAM))
SET SDMAX=$SELECT(+SDMAX:1,SDECNAM[SDECP:1,1:0)
QUIT
+4 QUIT
PROCESS(SDECIEN) ;Process an individual clinic
+1 ;MGH broke this out to do all locations or individual ones
+2 NEW SDECABR,SDECNAM,SDI,SDI1,SDDI,SDH,SDHDB,SDSP,SDSTOP
+3 NEW SDVVC,SDCRSTOP
+4 if '$DATA(^SC(+SDECIEN,0))
QUIT
+5 ;Q:$$INACTIVE(+SDECIEN) ;SD,796
+6 IF SDNOLET
IF '$ORDER(^SD(403.52,"B",+SDECIEN,0))
QUIT
+7 DO RESCLIN1^SDEC01B(SDECIEN)
+8 SET SDSLOTS=""
+9 KILL SDDATA,SDMSG
+10 ;alb/sat 665 - add abbreviation
SET SDFIELDS=".01;1;2;8;50.01;1912;1913;1914;1917;1918;1918.5"_$SELECT(SDNOSLOT:"",1:";1920*")_";2503;2505;2506;2507"
+11 DO GETS^DIQ(44,SDECIEN_",",SDFIELDS,"IE","SDDATA","SDMSG")
+12 if $GET(SDDATA(44,SDECIEN_",",2,"I"))'="C"
QUIT
+13 ;OOS?
if +$GET(SDDATA(44,SDECIEN_",",50.01,"I"))=1
QUIT
+14 ;alb/sat 672 - checking for duplicates
if $DATA(SDARR1(SDECIEN))
QUIT
+15 ;alb/sat 672 - checking for duplicates
SET SDARR1(SDECIEN)=""
+16 SET SDA="SDDATA(44,"""_SDECIEN_","")"
+17 ;length of appointment
SET SDAPLEN=@SDA@(1912,"E")
+18 ;variable appointment length V means yes
SET SDVAPL=@SDA@(1913,"I")
+19 ;hour clinic display begins
SET SDHDB=@SDA@(1914,"E")
+20 if SDHDB=""
SET SDHDB=8
+21 ;display increments per hour
SET SDDI=@SDA@(1917,"I")
+22 ;INACTIVATE
SET SDECINA=@SDA@(2505,"E")
+23 ;REACTIVATE
SET SDECREA=@SDA@(2506,"E")
+24 ;DEFAULT APPOINTMENT TYPE ien
SET SDECDAT=@SDA@(2507,"I")
+25 ;DEFAULT APPOINTMENT TYPE name
SET SDECDATN=@SDA@(2507,"E")
+26 ;STOP CODE NUMBER
SET SDSTOP=@SDA@(8,"I")
+27 SET SDECNAM=@SDA@(.01,"E")
+28 ;alb/sat 665
SET SDECABR=@SDA@(1,"E")
+29 ;alb/sat 665 - include abbr in name if found by C xref
SET SDECNAM=$SELECT((SDF["ABBR")&(@SDA@(1,"E")'=""):@SDA@(1,"E")_" ",1:"")_SDECNAM
+30 SET SDECMOB=@SDA@(1918,"E")
+31 SET SDH=@SDA@(1918.5,"I")
+32 ;$$GET1^DIQ(9009017.2,SDECIEN_",",.09) ;Create Visit at Check-In?
SET SDECCRV=1
+33 ;$$GET1^DIQ(9009017.2,SDECIEN_",",.12) ;Visit Service Category
SET SDECVSC=""
+34 ;$$GET1^DIQ(9009017.2,SDECIEN_",",.13) ;Multiple Clinic codes used?
SET SDECMULT=1
+35 ;$$GET1^DIQ(9009017.2,SDECIEN_",",.14) ;Visit Provider Required
SET SDECREQ=1
+36 ;$$GET1^DIQ(9009017.2,SDECIEN_",",.15) ;Generate PCCPlus Forms?
SET SDECPCC=0
+37 if 'SDNOSLOT
SET SDSLOTS=$$GETSLOTS(.SDDATA)
+38 SET SDECHPRV=$ORDER(^SC(+SDECIEN,"SDPRIV",0))>0
+39 SET SDECPROT=$GET(^SC(+SDECIEN,"SDPROT"))="Y"
+40 SET SDSP=""
SET SDI=0
FOR
SET SDI=$ORDER(^SC(+SDECIEN,"SI",SDI))
if SDI'>0
QUIT
SET SDI1=$GET(^SC(+SDECIEN,"SI",SDI,0))
if SDI1'=""
SET SDSP=$SELECT(SDSP'="":SDSP_$CHAR(13,10),1:"")_SDI1
+41 ;alb/sat 672
if SDECNAM'=""
SET SDV=$$GET^XPAR("PKG.SCHEDULING","SDEC VS GUI CLINIC VIEW",SDECNAM,"B")
+42 ;alb/sat 672
SET SDV=$SELECT(SDV'="":$PIECE(SDV,U,1),1:"W")
+43 SET SDVVC=0
+44 ;CREDIT STOP CODE NUMBER
SET SDCRSTOP=@SDA@(2503,"I")
+45 IF SDSTOP
SET SDVVC=$$VVCSTPCD(SDSTOP)
+46 IF 'SDVVC
IF SDCRSTOP
SET SDVVC=$$VVCSTPCD(SDCRSTOP)
+47 ; 1 2 3 4 5 6 7 8
+48 SET SDTMP=SDECIEN_U_SDECNAM_U_SDECCRV_U_SDECVSC_U_SDECMULT_U_SDECREQ_U_SDECPCC_U_SDECMOB
+49 ; 9 10 11 12 13 14 15
+50 SET SDTMP=SDTMP_U_SDECDAT_U_SDECDATN_U_+SDAPLEN_U_SDVAPL_U_SDSLOTS_U_SDECHPRV_U_SDECPROT
+51 ; 16 17 18 19 20 21 22 23
+52 ;alb/sat 672 - add SDV
SET SDTMP=SDTMP_U_SDHDB_U_SDDI_U_SDH_U_SDSP_U_SDSTOP_U_SDECABR_U_U_SDV
+53 ; 24
+54 ; ??? - add SDVVC
SET SDTMP=SDTMP_U_SDVVC
+55 SET SDAR(SDF["FULL",SDECNAM,SDECIEN)=SDTMP
+56 SET SDCNT=SDCNT+1
+57 QUIT
CHK(SDECP,SDECIEN) ;alb/sat 665 - stop if 'this' record found in abbreviations ;alb/sat 672 - removed
+1 QUIT
+2 NEW FND,SDR,SDX
+3 SET FND=0
+4 SET SDX=$$GETSUB^SDEC56(SDECP)
+5 FOR
SET SDX=$ORDER(^SC("C",SDX))
if SDX=""
QUIT
if SDX'[SDECP
QUIT
Begin DoDot:1
+6 SET SDR=0
FOR
SET SDR=$ORDER(^SC("C",SDX,SDR))
if '+SDR
QUIT
SET FND=SDR=SDECIEN
if +FND
QUIT
End DoDot:1
if +FND
QUIT
+7 QUIT FND
+8 ;
+9 ;
GETSLOTS(SDDATA) ;get slots - NUMBER OF PATIENTS in the AVAILABILITY multiple of file 44
+1 ;INPUT:
+2 ; SDDATA - array from GETS^DIQ against file 44 above to collect timeslots from
+3 NEW SDI,SDDT,SDSLOTS
+4 SET SDSLOTS=""
+5 SET SDI=""
FOR
SET SDI=$ORDER(SDDATA(44.004,SDI))
if SDI=""
QUIT
Begin DoDot:1
+6 ;get date
SET SDDT=$PIECE(SDI,",",2)
+7 ;get time
SET SDDT=SDDT_"."_SDDATA(44.004,SDI,.01,"I")
+8 SET SDDT=$$FMTE^XLFDT(SDDT)
+9 SET SDSLOTS=$SELECT(SDSLOTS'="":SDSLOTS_"|",1:"")_SDDT_";;"_SDDATA(44.004,SDI,1,"E")
End DoDot:1
+10 QUIT SDSLOTS
+11 ;
INACTIVE(SDCL,SDDT) ;determine if clinic is active
+1 ; X=0=ACTIVE
+2 ; X=1=INACTIVE
+3 NEW SDNODI,N21,N25,X
+4 SET SDDT=$GET(SDDT)
IF SDDT=""
SET SDDT=DT
+5 SET SDDT=$PIECE(SDDT,".",1)
+6 SET X=1
+7 SET SDNODI=$GET(^SC(SDCL,"I"))
+8 if SDNODI=""
QUIT 0
+9 ;inactive date/time
SET N21=$PIECE(SDNODI,U,1)
+10 ;reactive date/time
SET N25=$PIECE(SDNODI,U,2)
+11 IF (N21="")
SET X=0
QUIT X
+12 IF (N21'="")&(N21>SDDT)
SET X=0
QUIT X
+13 IF (N25'="")&(N25'>SDDT)
SET X=0
QUIT X
+14 QUIT X
+15 ;
PRIV(SDECY,CLINIEN,USER) ;IS this USER in the PRIVILEGED USER multiple for the clinic
+1 ;INPUT:
+2 ; CLINIEN - pointer to HOSPITAL LOCATION file 44
+3 ; USER - pointer to NEW PERSON file 200
+4 ;RETURN:
+5 ; A single boolean entry indicating that the USER is a PRIVILEGED USER for the clinic.
+6 ; RETURNCODE - 0=NO; 1=YES; -1=error
+7 ; MESSAGE
+8 NEW SDRET
+9 SET SDECY="^TMP(""SDEC32"","_$JOB_",""PRIV"")"
+10 KILL @SDECY
+11 SET @SDECY@(0)="T00030RETURNCODE^MESSAGE"_$CHAR(30)
+12 SET CLINIEN=$GET(CLINIEN)
+13 IF (CLINIEN="")!('$DATA(^SC(CLINIEN,0)))
SET @SDECY@(1)="-1^Invalid clinic ID."_$CHAR(30,31)
QUIT
+14 SET USER=$GET(USER)
+15 IF (USER="")!('$DATA(^VA(200,USER,0)))
SET @SDECY@(1)="-1^Invalid user ID."_$CHAR(30,31)
QUIT
+16 SET SDRET=$DATA(^SC(CLINIEN,"SDPRIV",USER,0))
+17 SET $PIECE(SDRET,U,2)=$SELECT(SDRET=1:"YES",1:"NO")
+18 SET @SDECY@(1)=SDRET_$CHAR(30,31)
+19 QUIT
+20 ;
BOOKHLDY(SDECY,SDECCL) ; Returns can book on holiday flag for a clinic. 12/1/17 wtc 679
+1 ;
+2 ; Returns value of field 1918.5 in file #44
+3 ;
+4 ; SDECY = return value
+5 ; SDECCL = pointer to file #44
+6 ;
+7 ;
SET SDECY=""
+8 ;
if $GET(SDECCL)=""
QUIT
+9 ;
SET SDECY=$PIECE($GET(^SC(SDECCL,"SL")),"^",8)
+10 ;
QUIT
+11 ;
VVCSTPCD(STOPCD) ;
+1 ; Called from PROCES tag above
+2 ;
+3 ;Input:
+4 ; STOPCD - a stop code
+5 ;
+6 ;Return:
+7 ; 1 = Stop code is found in the SDEC SETTING file (#409.98) field 7 VVC STOP CODE
+8 if '$GET(STOPCD)
QUIT
+9 NEW RETURN,STOP
+10 ;
+11 SET RETURN=0
+12 SET STOP=""
SET STOP=$$GET1^DIQ(40.7,STOPCD,1)
+13 IF STOP>0
Begin DoDot:1
+14 IF $DATA(^SDEC(409.98,1,3,"B",STOP))
SET RETURN=1
End DoDot:1
+15 QUIT RETURN
