SDEC56 ;ALB/SAT - VISTA SCHEDULING RPCS ;JUL 26, 2017
;;5.3;Scheduling;**627,642,651,665,672**;Aug 13, 1993;Build 9
;
Q
;
REP1GET(SDECY,MAXREC,LASTSUB,PNAME) ;GET clinic data for report
;INPUT:
; MAXREC - (optional) Max records returned
; LASTSUB - (optional) last subscripts from previous call
; PNAME - (optional) partial name
;RETURN:
; 1. CLINIEN - clinic ID pointer to HOSPITAL LOCATION file 44
; 2. CLINNAME - clinic NAME from HOSPITAL LOCATION file 44
; 3. TYPE - clinic type - only valid value is 'CLINIC'
; 4. INSTIEN - institution ID pointer to INSTITUTION file
; 5. INSTNAME - institution NAME from INSTITUTION file
; 6. DIVIEN - division ID pointer to MEDICAL CENTER DIVISION file 40.8
; 7. DIVNAME - division NAME from MEDICAL CENTER DIVISION file
; 8. STOP_CODE_ID - stop code ID pointer to CLINIC STOP file 40.7
; 9. STOP_CODE_NUMBER - stop code number
; 10. SERVICE - service assigned - valid values:
; MEDICINE
; SURGERY
; PSYCHIATRY
; REHAB MEDICINE
; NEUROLOGY
; NONE
; 11. TREATSPECID - treating specialty ID pointer to FACILITY TREATING SPECIALTY file 45.7
; 12. TREATSPECNAME - treating specialty NAME from FACILITY TREATING SPECIALTY file
; 13. PROVIEN - default provider ID pointer to NEW PERSON file 200
; 14. PROVNAME - default provider NAME from NEW PERSON file
; 15. AGENCYID - agency ID pointer to AGENCY file 4.11
; 16. AGENCYNAME - agency NAME from AGENCY file
; 17. APPTLEN - length of app't numeric 10-240 and multiple of 10 or 15
; 18. VAPPTLEN - variable appointment length 'V' means "YES, VARIABLE LENGTH"; otherwise null
; 19. PROHIBITACC - prohibit access to clinic? 'YES' or null
; 20. NON-COUNT - non-count clinic? 'YES' 'NO'
; 21. INACTIVATE_DT - inactivate date in external format - date clinic was inactivated
; 22. REACTIVATE_DT - reactivate date in external format - date clinic was reactivated
; 23. DEF-APPT-TYPE_ID - default appointment type ID pointer to APPOINTMENT TYPE file 409.1
; 24. DEF-APPT-TYPE_NAME - default appointment type NAME from APPOINTMENT TYPE file
; 25. PROVIDERS - Providers separated by pipe.
; Each pipe piece contains the following ;; pieces:
; 1. provider ID pointer to NEW PERSON FILE 200
; 2. provider NAME from NEW PERSON file
; 3. default provider? 'NO' 'YES'
; 26. CLIN-SVCS-RES_ID - clinic services resource ID pointer to
; 27. CLIN-SVCS-RES_NAME - clinic services resource NAME
; 28. CLINIC-GRP_ID - clinic group (reports) ID pointer to CLINIC GROUP file 409.67
; 29. CLINIC-GRP_NAME - clinic group (reports) NAME from CLINIC GROUP file
; 30. DATE - Date/Time this Clinic was created in external format
; 31. MAXDAYS - max # days for future booking 2002
; 32. LASTSUB - last subscripts of data in the return.
; Pass this as LASTSUB in the next call to continue
; collecting data.
N SDA,SDAUD,SDAUDNOD,SDCL,SDCLN,SDDATA,SDFIELDS,SDECI,SDI,SDMSG,SDTMP
N SDARR,SDCNT,SDECNAM,SDF,SDL,SDMORE ;alb/sat 665
N SDARR1,SDREF,SDXT ;alb/sat 672
S SDECY="^TMP(""SDEC56"","_$J_",""HLREP1"")"
K @SDECY
; 1 2 3 4 5
S SDTMP="T00030CLINIEN^T00030CLINNAME^T00030TYPE^T00030INSTIEN^T00030INSTNAME"
; 6 7 8 9
S SDTMP=SDTMP_"^T00030DIVIEN^T00030DIVNAME^T00030STOP_CODE_ID^T00030STOP_CODE_NUMBER"
; 10 11 12
S SDTMP=SDTMP_"^T00030SERVICE^T00030TREATSPECID^T00030TREATSPECNAME"
; 13 14 15 16 17
S SDTMP=SDTMP_"^T00030PROVIEN^T00030PROVNAME^T00030AGENCYID^T00030AGENCYNAME^T00030APPTLEN"
; 18 19 20 21
S SDTMP=SDTMP_"^T00030VAPPTLEN^T00030PROHIBITACC^T00030NON-COUNT^T00030INACTIVATE_DT"
; 22 23 24
S SDTMP=SDTMP_"^T00030REACTIVATE_DT^T00030DEF-APPT-TYPE_ID^T00030DEF-APPT-TYPE_NAME"
; 25 26 27
S SDTMP=SDTMP_"^T00030PROVIDERS^T00030CLIN-SVCS-RES_ID^T00030CLIN-SVCS-RES_NAME"
; 28 29 30
S SDTMP=SDTMP_"^T00030CLINIC-GRP_ID^T00030CLINIC-GRP_NAME^T00030DATE^T00030MAXDAYS^T00030LASTSUB^T00030ABBR" ;alb/sat 655 - add ABBR
S SDECI=0
S @SDECY@(SDECI)=SDTMP_$C(30)
S (SDCNT,SDF,SDMORE)=0 ;alb/sat 665
S MAXREC=+$G(MAXREC,50) ;alb/sat 665 - change from 200 to 50
S LASTSUB=$G(LASTSUB)
S PNAME=$G(PNAME)
I $G(PNAME)'="" D
.;alb/sat 672 - begin modification; separate string and numeric lookup
.S SDF=$S($P(LASTSUB,"|",1)'="":$P(LASTSUB,"|",1),1:"")
.S (SDECNAM,SDXT)=$S($P(LASTSUB,"|",2)'="":$$GETSUB^SDECU($P(LASTSUB,"|",2)),1:$$GETSUB^SDECU(PNAME))
.;abbreviation as string
.I ($P(LASTSUB,"|",1)="")!($P(LASTSUB,"|",1)="ABBRSTR") S SDF="ABBRSTR" D
..S SDREF="C" D PART Q
.;abbreviation as numeric
.I ($P(LASTSUB,"|",1)="")!($P(LASTSUB,"|",1)="ABBRNUM"),(+SDXT=SDXT) S SDF="ABBRNUM",SDECNAM=SDXT_" " D
..S SDREF="C" D PART Q
.;name as string
.I ($P(LASTSUB,"|",1)="")!($P(LASTSUB,"|",1)="FULLSTR") S SDF="FULLSTR",SDECNAM=SDXT D
..S SDREF="B" D PART Q
.;name as numeric
.I ($P(LASTSUB,"|",1)="")!($P(LASTSUB,"|",1)="FULLNUM"),(+SDXT=SDXT) S SDF="FULLNUM",SDECNAM=SDXT_" " D
..S SDREF="B" D PART Q
.;alb/sat 672 - end modification; separate string and numeric lookup
I PNAME="" D
.S SDECNAM=$S($P(LASTSUB,"|",2)'="":$$GETSUB($P(LASTSUB,"|",2)),PNAME'="":$$GETSUB(PNAME),1:"")
.F S SDECNAM=$O(^SC("AG","C",SDECNAM)) Q:SDECNAM="" D I SDCNT'<MAXREC S SDECNAM=$O(^SC("AG","C",SDECNAM)) S SDMORE=$S(+SDMORE:1,SDECNAM'="":1,1:0) Q
..S SDCL=$S($P(LASTSUB,"|",3)'="":$P(LASTSUB,"|",3),1:0)
..S LASTSUB=""
..F S SDCL=$O(^SC("AG","C",SDECNAM,SDCL)) Q:SDCL'>0 D I SDCNT'<MAXREC S SDMORE=$O(^SC("AG","C",SDECNAM,SDCL)) Q
...D GET1
S SDL=-1 F S SDL=$O(SDARR(SDL)) Q:SDL="" D
.S SDI="" F S SDI=$O(SDARR(SDL,SDI)) Q:SDI="" D
..S SDTMP=SDARR(SDL,SDI)
..S $P(SDTMP,U,32)=SDF_"|"_SDECNAM_"|"_SDCL
..S SDECI=SDECI+1 S @SDECY@(SDECI)=SDTMP_$C(30)
S:(SDECI>0)&('+SDMORE) $P(@SDECY@(SDECI),U,32)=""
S @SDECY@(SDECI)=@SDECY@(SDECI)_$C(31)
Q
PART ;partial name lookup ;alb/sat 672
Q:SDREF=""
F S SDECNAM=$O(^SC(SDREF,SDECNAM)) Q:SDECNAM'[PNAME D I SDCNT'<MAXREC S SDECNAM=$O(^SC(SDREF,SDECNAM)) S SDMORE=$S(+SDMORE:1,SDECNAM[PNAME:1,1:0) Q ;alb/sat 658 - abbreviation lookup if characters length 7 or less
.S SDCL=$S($P(LASTSUB,"|",3)'="":$P(LASTSUB,"|",3),1:0)
.S LASTSUB=""
.F S SDCL=$O(^SC(SDREF,SDECNAM,SDCL)) Q:SDCL="" D GET1 I SDCNT'<MAXREC S SDMORE=+$O(^SC(SDREF,SDECNAM,SDCL)) Q ;alb/sat 665 loop thru all entries
Q
GET1 ;get1 record
N FND
K SDDATA,SDMSG
S SDFIELDS=".01;1;2;3;3.5;8;9;9.5;16;23;29;31;50.01;1912;1913;2002;2500;2502;2505;2506;2507"
D GETS^DIQ(44,SDCL_",",SDFIELDS,"IE","SDDATA","SDMSG")
S SDA="SDDATA(44,"""_SDCL_","")"
Q:@SDA@(2,"I")'="C"
Q:+$G(@SDA@(50.01,"I"))=1 ;OOS?
Q:$D(SDARR1(SDCL)) ;alb/sat 672 - checking for duplicates
S SDARR1(SDCL)="" ;alb/sat 672 - checking for duplicates
S SDTMP=""
S $P(SDTMP,U,1)=SDCL ;clinic ID
S $P(SDTMP,U,2)=@SDA@(.01,"E") ;clinic name
S $P(SDTMP,U,33)=@SDA@(1,"E") ;clinic abbreviation
I SDF["ABBR",$P(SDTMP,U,33)'="" S $P(SDTMP,U,2)=$P(SDTMP,U,33)_" "_$P(SDTMP,U,2)
S $P(SDTMP,U,3)=@SDA@(2,"E") ;clinic type
S $P(SDTMP,U,4)=@SDA@(3,"I") ;institution ID
S $P(SDTMP,U,5)=@SDA@(3,"E") ;institution name
S $P(SDTMP,U,6)=@SDA@(3.5,"I") ;division ID
S $P(SDTMP,U,7)=@SDA@(3.5,"E") ;division NAME
S:@SDA@(8,"I") $P(SDTMP,U,8)=$$GET1^DIQ(40.7,@SDA@(8,"I"),1) ;stop code ID ;alb/sat 651
S $P(SDTMP,U,9)=@SDA@(8,"E") ;stop code number
S $P(SDTMP,U,10)=@SDA@(9,"E") ;service
S $P(SDTMP,U,11)=@SDA@(9.5,"I") ;treating specialty ID
S $P(SDTMP,U,12)=@SDA@(9.5,"E") ;treating specialty name
S $P(SDTMP,U,13)=@SDA@(16,"I") ;default provider ID
S $P(SDTMP,U,14)=@SDA@(16,"E") ;default provider name
S $P(SDTMP,U,15)=@SDA@(23,"I") ;agency ID
S $P(SDTMP,U,16)=@SDA@(23,"E") ;agency name
S $P(SDTMP,U,17)=+@SDA@(1912,"E") ;length of appointment
S $P(SDTMP,U,18)=@SDA@(1913,"I") ;variable appointment
S $P(SDTMP,U,19)=@SDA@(2500,"E") ;prohibit access to clinic
S $P(SDTMP,U,20)=@SDA@(2502,"E") ;non-count clinic?
S $P(SDTMP,U,21)=@SDA@(2505,"E") ;inactivate date
S $P(SDTMP,U,22)=@SDA@(2506,"E") ;reactivate date
S $P(SDTMP,U,23)=@SDA@(2507,"I") ;default appointment type ID
S $P(SDTMP,U,24)=@SDA@(2507,"E") ;default appointment type name
S $P(SDTMP,U,25)=$$GETPRV(SDCL) ;providers - IEN ;; NAME ;; DEF? | ...
S $P(SDTMP,U,26)=@SDA@(29,"I") ;clinic services resource ID
S $P(SDTMP,U,27)=@SDA@(29,"E") ;clinic services resource name
S $P(SDTMP,U,28)=@SDA@(31,"I") ;clinic group (reports) ID
S $P(SDTMP,U,29)=@SDA@(31,"E") ;clinic group (reports) name
S SDAUD=$O(^DIA(44,"B",SDCL,0))
S SDAUDNOD=$G(^DIA(44,+SDAUD,0))
I $P(SDAUDNOD,U,5)="A" S $P(SDTMP,U,30)=$$FMTE^XLFDT($P(SDAUDNOD,U,2),"M")
S $P(SDTMP,U,31)=@SDA@(2002,"E") ;max # days for future booking
S $P(SDTMP,U,32)="" ;LASTSUB setup after the loop in last record
;
S SDARR(SDF["FULL",$P(SDTMP,U,2))=SDTMP,SDCNT=SDCNT+1
;S SDECI=SDECI+1 S @SDECY@(SDECI)=SDTMP_$C(30)
Q
;
GETPRV(SDCL) ;get providers from PROVIDER multiple in file 44
;INPUT:
; SDCL - clinic ID pointer to HOSPITAL LOCATION file 44
;RETURN:
; PROVIDERS - Providers separated by pipe.
; Each pipe piece contains the following ;; pieces:
; 1. provider ID pointer to NEW PERSON FILE 200
; 2. provider NAME from NEW PERSON file
; 3. default provider? 'NO' 'YES'
N SDI,SDNOD,SDRET
S SDRET=""
S SDI=0 F S SDI=$O(^SC(SDCL,"PR",SDI)) Q:SDI'>0 D
.S SDNOD=$G(^SC(SDCL,"PR",SDI,0))
.S SDRET=$S(SDRET'="":SDRET_"|",1:"")_$P(SDNOD,U,1)_";;"_$$GET1^DIQ(200,$P(SDNOD,U,1)_",",.01)_";;"_$S($P(SDNOD,U,2)=1:"YES",1:"NO")
Q SDRET
;
GETSUB(TXT) ;
Q $$GETSUB^SDECU(TXT) ;alb/sat 665
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDEC56 10389 printed Sep 11, 2024@03:10:40 Page 2
SDEC56 ;ALB/SAT - VISTA SCHEDULING RPCS ;JUL 26, 2017
+1 ;;5.3;Scheduling;**627,642,651,665,672**;Aug 13, 1993;Build 9
+2 ;
+3 QUIT
+4 ;
REP1GET(SDECY,MAXREC,LASTSUB,PNAME) ;GET clinic data for report
+1 ;INPUT:
+2 ; MAXREC - (optional) Max records returned
+3 ; LASTSUB - (optional) last subscripts from previous call
+4 ; PNAME - (optional) partial name
+5 ;RETURN:
+6 ; 1. CLINIEN - clinic ID pointer to HOSPITAL LOCATION file 44
+7 ; 2. CLINNAME - clinic NAME from HOSPITAL LOCATION file 44
+8 ; 3. TYPE - clinic type - only valid value is 'CLINIC'
+9 ; 4. INSTIEN - institution ID pointer to INSTITUTION file
+10 ; 5. INSTNAME - institution NAME from INSTITUTION file
+11 ; 6. DIVIEN - division ID pointer to MEDICAL CENTER DIVISION file 40.8
+12 ; 7. DIVNAME - division NAME from MEDICAL CENTER DIVISION file
+13 ; 8. STOP_CODE_ID - stop code ID pointer to CLINIC STOP file 40.7
+14 ; 9. STOP_CODE_NUMBER - stop code number
+15 ; 10. SERVICE - service assigned - valid values:
+16 ; MEDICINE
+17 ; SURGERY
+18 ; PSYCHIATRY
+19 ; REHAB MEDICINE
+20 ; NEUROLOGY
+21 ; NONE
+22 ; 11. TREATSPECID - treating specialty ID pointer to FACILITY TREATING SPECIALTY file 45.7
+23 ; 12. TREATSPECNAME - treating specialty NAME from FACILITY TREATING SPECIALTY file
+24 ; 13. PROVIEN - default provider ID pointer to NEW PERSON file 200
+25 ; 14. PROVNAME - default provider NAME from NEW PERSON file
+26 ; 15. AGENCYID - agency ID pointer to AGENCY file 4.11
+27 ; 16. AGENCYNAME - agency NAME from AGENCY file
+28 ; 17. APPTLEN - length of app't numeric 10-240 and multiple of 10 or 15
+29 ; 18. VAPPTLEN - variable appointment length 'V' means "YES, VARIABLE LENGTH"; otherwise null
+30 ; 19. PROHIBITACC - prohibit access to clinic? 'YES' or null
+31 ; 20. NON-COUNT - non-count clinic? 'YES' 'NO'
+32 ; 21. INACTIVATE_DT - inactivate date in external format - date clinic was inactivated
+33 ; 22. REACTIVATE_DT - reactivate date in external format - date clinic was reactivated
+34 ; 23. DEF-APPT-TYPE_ID - default appointment type ID pointer to APPOINTMENT TYPE file 409.1
+35 ; 24. DEF-APPT-TYPE_NAME - default appointment type NAME from APPOINTMENT TYPE file
+36 ; 25. PROVIDERS - Providers separated by pipe.
+37 ; Each pipe piece contains the following ;; pieces:
+38 ; 1. provider ID pointer to NEW PERSON FILE 200
+39 ; 2. provider NAME from NEW PERSON file
+40 ; 3. default provider? 'NO' 'YES'
+41 ; 26. CLIN-SVCS-RES_ID - clinic services resource ID pointer to
+42 ; 27. CLIN-SVCS-RES_NAME - clinic services resource NAME
+43 ; 28. CLINIC-GRP_ID - clinic group (reports) ID pointer to CLINIC GROUP file 409.67
+44 ; 29. CLINIC-GRP_NAME - clinic group (reports) NAME from CLINIC GROUP file
+45 ; 30. DATE - Date/Time this Clinic was created in external format
+46 ; 31. MAXDAYS - max # days for future booking 2002
+47 ; 32. LASTSUB - last subscripts of data in the return.
+48 ; Pass this as LASTSUB in the next call to continue
+49 ; collecting data.
+50 NEW SDA,SDAUD,SDAUDNOD,SDCL,SDCLN,SDDATA,SDFIELDS,SDECI,SDI,SDMSG,SDTMP
+51 ;alb/sat 665
NEW SDARR,SDCNT,SDECNAM,SDF,SDL,SDMORE
+52 ;alb/sat 672
NEW SDARR1,SDREF,SDXT
+53 SET SDECY="^TMP(""SDEC56"","_$JOB_",""HLREP1"")"
+54 KILL @SDECY
+55 ; 1 2 3 4 5
+56 SET SDTMP="T00030CLINIEN^T00030CLINNAME^T00030TYPE^T00030INSTIEN^T00030INSTNAME"
+57 ; 6 7 8 9
+58 SET SDTMP=SDTMP_"^T00030DIVIEN^T00030DIVNAME^T00030STOP_CODE_ID^T00030STOP_CODE_NUMBER"
+59 ; 10 11 12
+60 SET SDTMP=SDTMP_"^T00030SERVICE^T00030TREATSPECID^T00030TREATSPECNAME"
+61 ; 13 14 15 16 17
+62 SET SDTMP=SDTMP_"^T00030PROVIEN^T00030PROVNAME^T00030AGENCYID^T00030AGENCYNAME^T00030APPTLEN"
+63 ; 18 19 20 21
+64 SET SDTMP=SDTMP_"^T00030VAPPTLEN^T00030PROHIBITACC^T00030NON-COUNT^T00030INACTIVATE_DT"
+65 ; 22 23 24
+66 SET SDTMP=SDTMP_"^T00030REACTIVATE_DT^T00030DEF-APPT-TYPE_ID^T00030DEF-APPT-TYPE_NAME"
+67 ; 25 26 27
+68 SET SDTMP=SDTMP_"^T00030PROVIDERS^T00030CLIN-SVCS-RES_ID^T00030CLIN-SVCS-RES_NAME"
+69 ; 28 29 30
+70 ;alb/sat 655 - add ABBR
SET SDTMP=SDTMP_"^T00030CLINIC-GRP_ID^T00030CLINIC-GRP_NAME^T00030DATE^T00030MAXDAYS^T00030LASTSUB^T00030ABBR"
+71 SET SDECI=0
+72 SET @SDECY@(SDECI)=SDTMP_$CHAR(30)
+73 ;alb/sat 665
SET (SDCNT,SDF,SDMORE)=0
+74 ;alb/sat 665 - change from 200 to 50
SET MAXREC=+$GET(MAXREC,50)
+75 SET LASTSUB=$GET(LASTSUB)
+76 SET PNAME=$GET(PNAME)
+77 IF $GET(PNAME)'=""
Begin DoDot:1
+78 ;alb/sat 672 - begin modification; separate string and numeric lookup
+79 SET SDF=$SELECT($PIECE(LASTSUB,"|",1)'="":$PIECE(LASTSUB,"|",1),1:"")
+80 SET (SDECNAM,SDXT)=$SELECT($PIECE(LASTSUB,"|",2)'="":$$GETSUB^SDECU($PIECE(LASTSUB,"|",2)),1:$$GETSUB^SDECU(PNAME))
+81 ;abbreviation as string
+82 IF ($PIECE(LASTSUB,"|",1)="")!($PIECE(LASTSUB,"|",1)="ABBRSTR")
SET SDF="ABBRSTR"
Begin DoDot:2
+83 SET SDREF="C"
DO PART
QUIT
End DoDot:2
+84 ;abbreviation as numeric
+85 IF ($PIECE(LASTSUB,"|",1)="")!($PIECE(LASTSUB,"|",1)="ABBRNUM")
IF (+SDXT=SDXT)
SET SDF="ABBRNUM"
SET SDECNAM=SDXT_" "
Begin DoDot:2
+86 SET SDREF="C"
DO PART
QUIT
End DoDot:2
+87 ;name as string
+88 IF ($PIECE(LASTSUB,"|",1)="")!($PIECE(LASTSUB,"|",1)="FULLSTR")
SET SDF="FULLSTR"
SET SDECNAM=SDXT
Begin DoDot:2
+89 SET SDREF="B"
DO PART
QUIT
End DoDot:2
+90 ;name as numeric
+91 IF ($PIECE(LASTSUB,"|",1)="")!($PIECE(LASTSUB,"|",1)="FULLNUM")
IF (+SDXT=SDXT)
SET SDF="FULLNUM"
SET SDECNAM=SDXT_" "
Begin DoDot:2
+92 SET SDREF="B"
DO PART
QUIT
End DoDot:2
+93 ;alb/sat 672 - end modification; separate string and numeric lookup
End DoDot:1
+94 IF PNAME=""
Begin DoDot:1
+95 SET SDECNAM=$SELECT($PIECE(LASTSUB,"|",2)'="":$$GETSUB($PIECE(LASTSUB,"|",2)),PNAME'="":$$GETSUB(PNAME),1:"")
+96 FOR
SET SDECNAM=$ORDER(^SC("AG","C",SDECNAM))
if SDECNAM=""
QUIT
Begin DoDot:2
+97 SET SDCL=$SELECT($PIECE(LASTSUB,"|",3)'="":$PIECE(LASTSUB,"|",3),1:0)
+98 SET LASTSUB=""
+99 FOR
SET SDCL=$ORDER(^SC("AG","C",SDECNAM,SDCL))
if SDCL'>0
QUIT
Begin DoDot:3
+100 DO GET1
End DoDot:3
IF SDCNT'<MAXREC
SET SDMORE=$ORDER(^SC("AG","C",SDECNAM,SDCL))
QUIT
End DoDot:2
IF SDCNT'<MAXREC
SET SDECNAM=$ORDER(^SC("AG","C",SDECNAM))
SET SDMORE=$SELECT(+SDMORE:1,SDECNAM'="":1,1:0)
QUIT
End DoDot:1
+101 SET SDL=-1
FOR
SET SDL=$ORDER(SDARR(SDL))
if SDL=""
QUIT
Begin DoDot:1
+102 SET SDI=""
FOR
SET SDI=$ORDER(SDARR(SDL,SDI))
if SDI=""
QUIT
Begin DoDot:2
+103 SET SDTMP=SDARR(SDL,SDI)
+104 SET $PIECE(SDTMP,U,32)=SDF_"|"_SDECNAM_"|"_SDCL
+105 SET SDECI=SDECI+1
SET @SDECY@(SDECI)=SDTMP_$CHAR(30)
End DoDot:2
End DoDot:1
+106 if (SDECI>0)&('+SDMORE)
SET $PIECE(@SDECY@(SDECI),U,32)=""
+107 SET @SDECY@(SDECI)=@SDECY@(SDECI)_$CHAR(31)
+108 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'[PNAME
QUIT
Begin DoDot:1
+3 SET SDCL=$SELECT($PIECE(LASTSUB,"|",3)'="":$PIECE(LASTSUB,"|",3),1:0)
+4 SET LASTSUB=""
+5 ;alb/sat 665 loop thru all entries
FOR
SET SDCL=$ORDER(^SC(SDREF,SDECNAM,SDCL))
if SDCL=""
QUIT
DO GET1
IF SDCNT'<MAXREC
SET SDMORE=+$ORDER(^SC(SDREF,SDECNAM,SDCL))
QUIT
End DoDot:1
IF SDCNT'<MAXREC
SET SDECNAM=$ORDER(^SC(SDREF,SDECNAM))
SET SDMORE=$SELECT(+SDMORE:1,SDECNAM[PNAME:1,1:0)
QUIT
+6 QUIT
GET1 ;get1 record
+1 NEW FND
+2 KILL SDDATA,SDMSG
+3 SET SDFIELDS=".01;1;2;3;3.5;8;9;9.5;16;23;29;31;50.01;1912;1913;2002;2500;2502;2505;2506;2507"
+4 DO GETS^DIQ(44,SDCL_",",SDFIELDS,"IE","SDDATA","SDMSG")
+5 SET SDA="SDDATA(44,"""_SDCL_","")"
+6 if @SDA@(2,"I")'="C"
QUIT
+7 ;OOS?
if +$GET(@SDA@(50.01,"I"))=1
QUIT
+8 ;alb/sat 672 - checking for duplicates
if $DATA(SDARR1(SDCL))
QUIT
+9 ;alb/sat 672 - checking for duplicates
SET SDARR1(SDCL)=""
+10 SET SDTMP=""
+11 ;clinic ID
SET $PIECE(SDTMP,U,1)=SDCL
+12 ;clinic name
SET $PIECE(SDTMP,U,2)=@SDA@(.01,"E")
+13 ;clinic abbreviation
SET $PIECE(SDTMP,U,33)=@SDA@(1,"E")
+14 IF SDF["ABBR"
IF $PIECE(SDTMP,U,33)'=""
SET $PIECE(SDTMP,U,2)=$PIECE(SDTMP,U,33)_" "_$PIECE(SDTMP,U,2)
+15 ;clinic type
SET $PIECE(SDTMP,U,3)=@SDA@(2,"E")
+16 ;institution ID
SET $PIECE(SDTMP,U,4)=@SDA@(3,"I")
+17 ;institution name
SET $PIECE(SDTMP,U,5)=@SDA@(3,"E")
+18 ;division ID
SET $PIECE(SDTMP,U,6)=@SDA@(3.5,"I")
+19 ;division NAME
SET $PIECE(SDTMP,U,7)=@SDA@(3.5,"E")
+20 ;stop code ID ;alb/sat 651
if @SDA@(8,"I")
SET $PIECE(SDTMP,U,8)=$$GET1^DIQ(40.7,@SDA@(8,"I"),1)
+21 ;stop code number
SET $PIECE(SDTMP,U,9)=@SDA@(8,"E")
+22 ;service
SET $PIECE(SDTMP,U,10)=@SDA@(9,"E")
+23 ;treating specialty ID
SET $PIECE(SDTMP,U,11)=@SDA@(9.5,"I")
+24 ;treating specialty name
SET $PIECE(SDTMP,U,12)=@SDA@(9.5,"E")
+25 ;default provider ID
SET $PIECE(SDTMP,U,13)=@SDA@(16,"I")
+26 ;default provider name
SET $PIECE(SDTMP,U,14)=@SDA@(16,"E")
+27 ;agency ID
SET $PIECE(SDTMP,U,15)=@SDA@(23,"I")
+28 ;agency name
SET $PIECE(SDTMP,U,16)=@SDA@(23,"E")
+29 ;length of appointment
SET $PIECE(SDTMP,U,17)=+@SDA@(1912,"E")
+30 ;variable appointment
SET $PIECE(SDTMP,U,18)=@SDA@(1913,"I")
+31 ;prohibit access to clinic
SET $PIECE(SDTMP,U,19)=@SDA@(2500,"E")
+32 ;non-count clinic?
SET $PIECE(SDTMP,U,20)=@SDA@(2502,"E")
+33 ;inactivate date
SET $PIECE(SDTMP,U,21)=@SDA@(2505,"E")
+34 ;reactivate date
SET $PIECE(SDTMP,U,22)=@SDA@(2506,"E")
+35 ;default appointment type ID
SET $PIECE(SDTMP,U,23)=@SDA@(2507,"I")
+36 ;default appointment type name
SET $PIECE(SDTMP,U,24)=@SDA@(2507,"E")
+37 ;providers - IEN ;; NAME ;; DEF? | ...
SET $PIECE(SDTMP,U,25)=$$GETPRV(SDCL)
+38 ;clinic services resource ID
SET $PIECE(SDTMP,U,26)=@SDA@(29,"I")
+39 ;clinic services resource name
SET $PIECE(SDTMP,U,27)=@SDA@(29,"E")
+40 ;clinic group (reports) ID
SET $PIECE(SDTMP,U,28)=@SDA@(31,"I")
+41 ;clinic group (reports) name
SET $PIECE(SDTMP,U,29)=@SDA@(31,"E")
+42 SET SDAUD=$ORDER(^DIA(44,"B",SDCL,0))
+43 SET SDAUDNOD=$GET(^DIA(44,+SDAUD,0))
+44 IF $PIECE(SDAUDNOD,U,5)="A"
SET $PIECE(SDTMP,U,30)=$$FMTE^XLFDT($PIECE(SDAUDNOD,U,2),"M")
+45 ;max # days for future booking
SET $PIECE(SDTMP,U,31)=@SDA@(2002,"E")
+46 ;LASTSUB setup after the loop in last record
SET $PIECE(SDTMP,U,32)=""
+47 ;
+48 SET SDARR(SDF["FULL",$PIECE(SDTMP,U,2))=SDTMP
SET SDCNT=SDCNT+1
+49 ;S SDECI=SDECI+1 S @SDECY@(SDECI)=SDTMP_$C(30)
+50 QUIT
+51 ;
GETPRV(SDCL) ;get providers from PROVIDER multiple in file 44
+1 ;INPUT:
+2 ; SDCL - clinic ID pointer to HOSPITAL LOCATION file 44
+3 ;RETURN:
+4 ; PROVIDERS - Providers separated by pipe.
+5 ; Each pipe piece contains the following ;; pieces:
+6 ; 1. provider ID pointer to NEW PERSON FILE 200
+7 ; 2. provider NAME from NEW PERSON file
+8 ; 3. default provider? 'NO' 'YES'
+9 NEW SDI,SDNOD,SDRET
+10 SET SDRET=""
+11 SET SDI=0
FOR
SET SDI=$ORDER(^SC(SDCL,"PR",SDI))
if SDI'>0
QUIT
Begin DoDot:1
+12 SET SDNOD=$GET(^SC(SDCL,"PR",SDI,0))
+13 SET SDRET=$SELECT(SDRET'="":SDRET_"|",1:"")_$PIECE(SDNOD,U,1)_";;"_$$GET1^DIQ(200,$PIECE(SDNOD,U,1)_",",.01)_";;"_$SELECT($PIECE(SDNOD,U,2)=1:"YES",1:"NO")
End DoDot:1
+14 QUIT SDRET
+15 ;
GETSUB(TXT) ;
+1 ;alb/sat 665
QUIT $$GETSUB^SDECU(TXT)
