- 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 Feb 19, 2025@00:17:21 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)