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

SDEC56.m

Go to the documentation of this file.
  1. SDEC56 ;ALB/SAT - VISTA SCHEDULING RPCS ;JUL 26, 2017
  1. ;;5.3;Scheduling;**627,642,651,665,672**;Aug 13, 1993;Build 9
  1. ;
  1. Q
  1. ;
  1. REP1GET(SDECY,MAXREC,LASTSUB,PNAME) ;GET clinic data for report
  1. ;INPUT:
  1. ; MAXREC - (optional) Max records returned
  1. ; LASTSUB - (optional) last subscripts from previous call
  1. ; PNAME - (optional) partial name
  1. ;RETURN:
  1. ; 1. CLINIEN - clinic ID pointer to HOSPITAL LOCATION file 44
  1. ; 2. CLINNAME - clinic NAME from HOSPITAL LOCATION file 44
  1. ; 3. TYPE - clinic type - only valid value is 'CLINIC'
  1. ; 4. INSTIEN - institution ID pointer to INSTITUTION file
  1. ; 5. INSTNAME - institution NAME from INSTITUTION file
  1. ; 6. DIVIEN - division ID pointer to MEDICAL CENTER DIVISION file 40.8
  1. ; 7. DIVNAME - division NAME from MEDICAL CENTER DIVISION file
  1. ; 8. STOP_CODE_ID - stop code ID pointer to CLINIC STOP file 40.7
  1. ; 9. STOP_CODE_NUMBER - stop code number
  1. ; 10. SERVICE - service assigned - valid values:
  1. ; MEDICINE
  1. ; SURGERY
  1. ; PSYCHIATRY
  1. ; REHAB MEDICINE
  1. ; NEUROLOGY
  1. ; NONE
  1. ; 11. TREATSPECID - treating specialty ID pointer to FACILITY TREATING SPECIALTY file 45.7
  1. ; 12. TREATSPECNAME - treating specialty NAME from FACILITY TREATING SPECIALTY file
  1. ; 13. PROVIEN - default provider ID pointer to NEW PERSON file 200
  1. ; 14. PROVNAME - default provider NAME from NEW PERSON file
  1. ; 15. AGENCYID - agency ID pointer to AGENCY file 4.11
  1. ; 16. AGENCYNAME - agency NAME from AGENCY file
  1. ; 17. APPTLEN - length of app't numeric 10-240 and multiple of 10 or 15
  1. ; 18. VAPPTLEN - variable appointment length 'V' means "YES, VARIABLE LENGTH"; otherwise null
  1. ; 19. PROHIBITACC - prohibit access to clinic? 'YES' or null
  1. ; 20. NON-COUNT - non-count clinic? 'YES' 'NO'
  1. ; 21. INACTIVATE_DT - inactivate date in external format - date clinic was inactivated
  1. ; 22. REACTIVATE_DT - reactivate date in external format - date clinic was reactivated
  1. ; 23. DEF-APPT-TYPE_ID - default appointment type ID pointer to APPOINTMENT TYPE file 409.1
  1. ; 24. DEF-APPT-TYPE_NAME - default appointment type NAME from APPOINTMENT TYPE file
  1. ; 25. PROVIDERS - Providers separated by pipe.
  1. ; Each pipe piece contains the following ;; pieces:
  1. ; 1. provider ID pointer to NEW PERSON FILE 200
  1. ; 2. provider NAME from NEW PERSON file
  1. ; 3. default provider? 'NO' 'YES'
  1. ; 26. CLIN-SVCS-RES_ID - clinic services resource ID pointer to
  1. ; 27. CLIN-SVCS-RES_NAME - clinic services resource NAME
  1. ; 28. CLINIC-GRP_ID - clinic group (reports) ID pointer to CLINIC GROUP file 409.67
  1. ; 29. CLINIC-GRP_NAME - clinic group (reports) NAME from CLINIC GROUP file
  1. ; 30. DATE - Date/Time this Clinic was created in external format
  1. ; 31. MAXDAYS - max # days for future booking 2002
  1. ; 32. LASTSUB - last subscripts of data in the return.
  1. ; Pass this as LASTSUB in the next call to continue
  1. ; collecting data.
  1. N SDA,SDAUD,SDAUDNOD,SDCL,SDCLN,SDDATA,SDFIELDS,SDECI,SDI,SDMSG,SDTMP
  1. N SDARR,SDCNT,SDECNAM,SDF,SDL,SDMORE ;alb/sat 665
  1. N SDARR1,SDREF,SDXT ;alb/sat 672
  1. S SDECY="^TMP(""SDEC56"","_$J_",""HLREP1"")"
  1. K @SDECY
  1. ; 1 2 3 4 5
  1. S SDTMP="T00030CLINIEN^T00030CLINNAME^T00030TYPE^T00030INSTIEN^T00030INSTNAME"
  1. ; 6 7 8 9
  1. S SDTMP=SDTMP_"^T00030DIVIEN^T00030DIVNAME^T00030STOP_CODE_ID^T00030STOP_CODE_NUMBER"
  1. ; 10 11 12
  1. S SDTMP=SDTMP_"^T00030SERVICE^T00030TREATSPECID^T00030TREATSPECNAME"
  1. ; 13 14 15 16 17
  1. S SDTMP=SDTMP_"^T00030PROVIEN^T00030PROVNAME^T00030AGENCYID^T00030AGENCYNAME^T00030APPTLEN"
  1. ; 18 19 20 21
  1. S SDTMP=SDTMP_"^T00030VAPPTLEN^T00030PROHIBITACC^T00030NON-COUNT^T00030INACTIVATE_DT"
  1. ; 22 23 24
  1. S SDTMP=SDTMP_"^T00030REACTIVATE_DT^T00030DEF-APPT-TYPE_ID^T00030DEF-APPT-TYPE_NAME"
  1. ; 25 26 27
  1. S SDTMP=SDTMP_"^T00030PROVIDERS^T00030CLIN-SVCS-RES_ID^T00030CLIN-SVCS-RES_NAME"
  1. ; 28 29 30
  1. S SDTMP=SDTMP_"^T00030CLINIC-GRP_ID^T00030CLINIC-GRP_NAME^T00030DATE^T00030MAXDAYS^T00030LASTSUB^T00030ABBR" ;alb/sat 655 - add ABBR
  1. S SDECI=0
  1. S @SDECY@(SDECI)=SDTMP_$C(30)
  1. S (SDCNT,SDF,SDMORE)=0 ;alb/sat 665
  1. S MAXREC=+$G(MAXREC,50) ;alb/sat 665 - change from 200 to 50
  1. S LASTSUB=$G(LASTSUB)
  1. S PNAME=$G(PNAME)
  1. I $G(PNAME)'="" D
  1. .;alb/sat 672 - begin modification; separate string and numeric lookup
  1. .S SDF=$S($P(LASTSUB,"|",1)'="":$P(LASTSUB,"|",1),1:"")
  1. .S (SDECNAM,SDXT)=$S($P(LASTSUB,"|",2)'="":$$GETSUB^SDECU($P(LASTSUB,"|",2)),1:$$GETSUB^SDECU(PNAME))
  1. .;abbreviation as string
  1. .I ($P(LASTSUB,"|",1)="")!($P(LASTSUB,"|",1)="ABBRSTR") S SDF="ABBRSTR" D
  1. ..S SDREF="C" D PART Q
  1. .;abbreviation as numeric
  1. .I ($P(LASTSUB,"|",1)="")!($P(LASTSUB,"|",1)="ABBRNUM"),(+SDXT=SDXT) S SDF="ABBRNUM",SDECNAM=SDXT_" " D
  1. ..S SDREF="C" D PART Q
  1. .;name as string
  1. .I ($P(LASTSUB,"|",1)="")!($P(LASTSUB,"|",1)="FULLSTR") S SDF="FULLSTR",SDECNAM=SDXT D
  1. ..S SDREF="B" D PART Q
  1. .;name as numeric
  1. .I ($P(LASTSUB,"|",1)="")!($P(LASTSUB,"|",1)="FULLNUM"),(+SDXT=SDXT) S SDF="FULLNUM",SDECNAM=SDXT_" " D
  1. ..S SDREF="B" D PART Q
  1. .;alb/sat 672 - end modification; separate string and numeric lookup
  1. I PNAME="" D
  1. .S SDECNAM=$S($P(LASTSUB,"|",2)'="":$$GETSUB($P(LASTSUB,"|",2)),PNAME'="":$$GETSUB(PNAME),1:"")
  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
  1. ..S SDCL=$S($P(LASTSUB,"|",3)'="":$P(LASTSUB,"|",3),1:0)
  1. ..S LASTSUB=""
  1. ..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
  1. ...D GET1
  1. S SDL=-1 F S SDL=$O(SDARR(SDL)) Q:SDL="" D
  1. .S SDI="" F S SDI=$O(SDARR(SDL,SDI)) Q:SDI="" D
  1. ..S SDTMP=SDARR(SDL,SDI)
  1. ..S $P(SDTMP,U,32)=SDF_"|"_SDECNAM_"|"_SDCL
  1. ..S SDECI=SDECI+1 S @SDECY@(SDECI)=SDTMP_$C(30)
  1. S:(SDECI>0)&('+SDMORE) $P(@SDECY@(SDECI),U,32)=""
  1. S @SDECY@(SDECI)=@SDECY@(SDECI)_$C(31)
  1. Q
  1. PART ;partial name lookup ;alb/sat 672
  1. Q:SDREF=""
  1. 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
  1. .S SDCL=$S($P(LASTSUB,"|",3)'="":$P(LASTSUB,"|",3),1:0)
  1. .S LASTSUB=""
  1. .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
  1. Q
  1. GET1 ;get1 record
  1. N FND
  1. K SDDATA,SDMSG
  1. 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"
  1. D GETS^DIQ(44,SDCL_",",SDFIELDS,"IE","SDDATA","SDMSG")
  1. S SDA="SDDATA(44,"""_SDCL_","")"
  1. Q:@SDA@(2,"I")'="C"
  1. Q:+$G(@SDA@(50.01,"I"))=1 ;OOS?
  1. Q:$D(SDARR1(SDCL)) ;alb/sat 672 - checking for duplicates
  1. S SDARR1(SDCL)="" ;alb/sat 672 - checking for duplicates
  1. S SDTMP=""
  1. S $P(SDTMP,U,1)=SDCL ;clinic ID
  1. S $P(SDTMP,U,2)=@SDA@(.01,"E") ;clinic name
  1. S $P(SDTMP,U,33)=@SDA@(1,"E") ;clinic abbreviation
  1. I SDF["ABBR",$P(SDTMP,U,33)'="" S $P(SDTMP,U,2)=$P(SDTMP,U,33)_" "_$P(SDTMP,U,2)
  1. S $P(SDTMP,U,3)=@SDA@(2,"E") ;clinic type
  1. S $P(SDTMP,U,4)=@SDA@(3,"I") ;institution ID
  1. S $P(SDTMP,U,5)=@SDA@(3,"E") ;institution name
  1. S $P(SDTMP,U,6)=@SDA@(3.5,"I") ;division ID
  1. S $P(SDTMP,U,7)=@SDA@(3.5,"E") ;division NAME
  1. S:@SDA@(8,"I") $P(SDTMP,U,8)=$$GET1^DIQ(40.7,@SDA@(8,"I"),1) ;stop code ID ;alb/sat 651
  1. S $P(SDTMP,U,9)=@SDA@(8,"E") ;stop code number
  1. S $P(SDTMP,U,10)=@SDA@(9,"E") ;service
  1. S $P(SDTMP,U,11)=@SDA@(9.5,"I") ;treating specialty ID
  1. S $P(SDTMP,U,12)=@SDA@(9.5,"E") ;treating specialty name
  1. S $P(SDTMP,U,13)=@SDA@(16,"I") ;default provider ID
  1. S $P(SDTMP,U,14)=@SDA@(16,"E") ;default provider name
  1. S $P(SDTMP,U,15)=@SDA@(23,"I") ;agency ID
  1. S $P(SDTMP,U,16)=@SDA@(23,"E") ;agency name
  1. S $P(SDTMP,U,17)=+@SDA@(1912,"E") ;length of appointment
  1. S $P(SDTMP,U,18)=@SDA@(1913,"I") ;variable appointment
  1. S $P(SDTMP,U,19)=@SDA@(2500,"E") ;prohibit access to clinic
  1. S $P(SDTMP,U,20)=@SDA@(2502,"E") ;non-count clinic?
  1. S $P(SDTMP,U,21)=@SDA@(2505,"E") ;inactivate date
  1. S $P(SDTMP,U,22)=@SDA@(2506,"E") ;reactivate date
  1. S $P(SDTMP,U,23)=@SDA@(2507,"I") ;default appointment type ID
  1. S $P(SDTMP,U,24)=@SDA@(2507,"E") ;default appointment type name
  1. S $P(SDTMP,U,25)=$$GETPRV(SDCL) ;providers - IEN ;; NAME ;; DEF? | ...
  1. S $P(SDTMP,U,26)=@SDA@(29,"I") ;clinic services resource ID
  1. S $P(SDTMP,U,27)=@SDA@(29,"E") ;clinic services resource name
  1. S $P(SDTMP,U,28)=@SDA@(31,"I") ;clinic group (reports) ID
  1. S $P(SDTMP,U,29)=@SDA@(31,"E") ;clinic group (reports) name
  1. S SDAUD=$O(^DIA(44,"B",SDCL,0))
  1. S SDAUDNOD=$G(^DIA(44,+SDAUD,0))
  1. I $P(SDAUDNOD,U,5)="A" S $P(SDTMP,U,30)=$$FMTE^XLFDT($P(SDAUDNOD,U,2),"M")
  1. S $P(SDTMP,U,31)=@SDA@(2002,"E") ;max # days for future booking
  1. S $P(SDTMP,U,32)="" ;LASTSUB setup after the loop in last record
  1. ;
  1. S SDARR(SDF["FULL",$P(SDTMP,U,2))=SDTMP,SDCNT=SDCNT+1
  1. ;S SDECI=SDECI+1 S @SDECY@(SDECI)=SDTMP_$C(30)
  1. Q
  1. ;
  1. GETPRV(SDCL) ;get providers from PROVIDER multiple in file 44
  1. ;INPUT:
  1. ; SDCL - clinic ID pointer to HOSPITAL LOCATION file 44
  1. ;RETURN:
  1. ; PROVIDERS - Providers separated by pipe.
  1. ; Each pipe piece contains the following ;; pieces:
  1. ; 1. provider ID pointer to NEW PERSON FILE 200
  1. ; 2. provider NAME from NEW PERSON file
  1. ; 3. default provider? 'NO' 'YES'
  1. N SDI,SDNOD,SDRET
  1. S SDRET=""
  1. S SDI=0 F S SDI=$O(^SC(SDCL,"PR",SDI)) Q:SDI'>0 D
  1. .S SDNOD=$G(^SC(SDCL,"PR",SDI,0))
  1. .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")
  1. Q SDRET
  1. ;
  1. GETSUB(TXT) ;
  1. Q $$GETSUB^SDECU(TXT) ;alb/sat 665