Routine: SDEC01A

SDEC01A ;ALB/SAT,BLB - VISTA SCHEDULING RPCS ;MAR 14, 2022

 ;;5.3;Scheduling;**627,642,658,665,672,809**;Aug 13, 1993;Build 10

RESOURCE(SDECY,SDECDUZ,SDACT,SDTYPE,MAXREC,LASTSUBI,SDIEN,SDECP) ;Returns ADO Recordset with ALL RESOURCE names

 ;   SDECDUZ = (optional) pointer to NEW PERSON file

 ;                       Defaults to current user

 ;                       checks that overbook is allowed

 ;   SDACT   = (optional) 1 or YES will return only active resources

 ;                       0, NO, or null will include inactive

 ;   SDTYPE    = (optional) null will return all resource types

 ;            H will only return HOSPITAL LOCATION (clinic) resources

 ;            P will only return NEW PERSON (Provider) resources

 ;            A will only return SDEC ADDITIONAL RESOURCE resources

 ;            PH will only return prohibited clinics

 ;   MAXREC   - (optional) Max records returned

 ;   LASTSUBI - (optional) last subscripts from previous call

 ;   SDIEN    - (optional) pointer to SDEC RESOURCE file

 ;                         only 1 record will be returned if SDIEN is present

 ;   SDECP  - (optional) Partial name text

 ;RETURN:

 ;  Successful Return:

 ;   a global array in which each array entry contains data from the

 ;      SDEC RESOURCE file

 ;   1. RESOURCEID - Pointer to the SDEC RESOURCE file

 ;   2. RESOURCE_NAME - NAME from SDEC RESOURCE file

 ;   3. INACTIVE   - inactive Clinic - Returned values will be NO YES

 ;   4. TIMESCALE - Valid Values:

 ;                    5, 10, 15, 20, 30, 60

 ;   5. HOSPITAL_LOCATION_ID

 ;   6. <NOT USED> LETTER_TEXT

 ;   7. <NOT USED> NO_SHOW_LETTER

 ;   8. <NOT USED> CLINIC_CANCELLATION_LETTER

 ;   9. VIEW - User can VIEW 1=YES; 0=NO

 ;  10. OVERBOOK - User can OVERBOOK  1=YES; 0=NO

 ;  11. MODIFY_SCHEDULE - User can Modify Schedule  1=YES; 0=NO

 ;  12. MODIFY_APPOINTMENTS User can modify appointments  1=YES; 0=NO

 ;  13. RESOURCETYPE - 3 pipe pieces:

 ;          1. type H, P, or A

 ;          2. IEN - pointer to [H] HOSPITAL LOCATION, [P] NEW PERSON,

 ;                   or [A] SDEC ADDITIONAL RESOURCE file

 ;          3. Name - name from the appropriate type file

 ;  14. DATE      - Date/Time entered in external format

 ;  15. USERIEN   - Entered By User ID pointer to NEW PERSON file 200

 ;  16. USERNAME  - Entered By User name from NEW PERSON file

 ;  17. DATE1     - Inactive Date/Time in external format

 ;  18. USERIEN1  - Inactivating User ID pointer to NEW PERSON file

 ;  19. USERNAME1 - Inactivating User Name from NEW PERSON file

 ;  20. DATE2     - Reactivated Date/Time in external format

 ;  21. USERIEN2  - Reactivating User ID pointer to NEW PERSON file

 ;  22. USERNAME2 - Reactivating User Name from NEW PERSON file

 ;  23. CLINNAME  - Clinic Name from HOSPITAL LOCATION file 44

 ;  24. PROVCLIN  - Boolean indicating 'this' P type resource is a provider for a clinic

 ;                  0  = not a provider (not found in the AVADPR index for file 44)

 ;                  1  = is a provider

 ;  25. PRIVLOC   - Boolean indicating presence of privileged users for hospital location

 ;  26. PRHBLOC   - Boolean indicating if location is a Prohibit Access clinic

 ;  27. LASTSUB   - Last subscript in return data. Used in next call to

 ;                  SDEC RESOURCE to get additional records

 ;  28. ABBR      - Abbreviation

 N SDA,SDCL,SDDATA,SDMSG,SDECERR,SDECRET,SDECIEN,SDECRES,SDECDEP,SDECDDR,SDECDEPN,SDECRDAT,SDECRNOD,SDECI,SDEC,SDECLTR

 N ABBR,SDECNOS,SDECCAN,SDF,SDTYPR,SDX,SDPRO,PRO,SDH,SDK,SDRT,SDT,SDXT,TIMEZONE,CLINICIEN

 N SDARR,SDARR1,SDCNT,SDMORE,SDNAM,SDREF          ;alb/sat 665  ;alb/sat 672 add SDARR1,SDREF

 N SDVW  ;alb/sat 672

 S (SDRT,SDT,SDX)="",SDPRO=0

 S (SDCNT,SDF,SDMORE)=0

 S SDVW=""  ;alb/sat 672

 S SDECY="^TMP(""SDEC01A"","_$J_",""RESOURCE"")"

 K @SDECY

 S SDECI=0

 S (SDECERR,SDTYPR)=""

 ;                       1                2                   3              4               5                          6                 7

 S @SDECY@(SDECI)="I00010RESOURCEID^T00030RESOURCE_NAME^T00010INACTIVE^I00010TIMESCALE^I00010HOSPITAL_LOCATION_ID^T00030LETTER_TEXT^T00030NO_SHOW_LETTER"

 ;                                 8                                9          10             11                    12

 S @SDECY@(SDECI)=^(SDECI)_"^T00030CLINIC_CANCELLATION_LETTER^I00010VIEW^I00010OVERBOOK^I00010MODIFY_SCHEDULE^I00010MODIFY_APPOINTMENTS"

 ;                                 13                 14         15            16

 S @SDECY@(SDECI)=^(SDECI)_"^T00030RESOURCETYPE^T00030DATE^T00030USERIEN^T00030USERNAME"

 ;                                 17          18             19              20          21             22

 S @SDECY@(SDECI)=^(SDECI)_"^T00030DATE1^T00030USERIEN1^T00030USERNAME1^T00030DATE2^T00030USERIEN2^T00030USERNAME2"

 ;                                 23             24           25              26            27

 S @SDECY@(SDECI)=^(SDECI)_"^T00030CLINNAME^T00030PROVCLIN^T00030PRIVLOC^T00030PRHBLOC^T00030LASTSUB^T00030ABBR"

 S @SDECY@(SDECI)=^(SDECI)_"^T00030DEFAULT_VIEW^T00030TIMEZONE"_$C(30)  ;alb/sat 672 - add DEFAULT_VIEW

 ;validate user

 S SDECDUZ=$G(SDECDUZ)

 I '+SDECDUZ S SDECDUZ=DUZ

 ;validate active

 S SDACT=$G(SDACT)

 S SDACT=$S(SDACT=1:1,SDACT="YES":1,1:0)

 ;validate type

 S SDTYPE=$G(SDTYPE)

 ;MGH added new type

 I SDTYPE="PH" S SDPRO=1

 S SDTYPE=$S(SDTYPE="H":"SC(",SDTYPE="P":"VA(200",SDTYPE="A":"SDEC",1:"")

 ;validate MAXREC

 S MAXREC=$G(MAXREC,9999999)

 ;validate LASTSUBI

 S LASTSUBI=$G(LASTSUBI)

 ;validate SDIEN

 ;MGH changed to allow multiple IENS

 ;S SDIEN=$G(SDIEN)

 ;I SDIEN'="",'$D(^SDEC(409.831,+SDIEN,0)) S SDIEN=""

 I $G(SDIEN) D  G RESX

 .F SDK=1:1:$L(SDIEN,"|") D

 ..S SDECIEN=$P(SDIEN,"|",SDK)

 ..Q:'$D(^SDEC(409.831,+SDECIEN,0))

 ..S SDECRES=SDECIEN

 ..D RES1

 ;ien lookup

 ;I +SDIEN S SDECRES=+SDIEN D RES1 G RESX

 ;validate SDECP

 S SDECP=$G(SDECP)

 ;partial name lookup

 I SDECP'="" D

 .S SDF=$S($P(LASTSUBI,"|",1)'="":$P(LASTSUBI,"|",1),1:"")

 .;alb/sat 672 - begin modification; separate string and numeric lookup

 .S (SDX,SDXT)=$S($P(LASTSUBI,"|",2)'="":$$GETSUB^SDECU($P(LASTSUBI,"|",2)),1:$$GETSUB^SDECU(SDECP))

 .;abbreviation as string

 .I ($P(LASTSUBI,"|",1)="")!($P(LASTSUBI,"|",1)="ABBRSTR") S SDF="ABBRSTR" D

 ..S SDREF="C" D PART Q

 .;abbreviation as numeric

 .I ($P(LASTSUBI,"|",1)="")!($P(LASTSUBI,"|",1)="ABBRNUM"),(+SDXT=SDXT) S SDF="ABBRNUM",SDX=SDXT_" " D

 ..S SDREF="C" D PART Q

 .;name as string

 .I ($P(LASTSUBI,"|",1)="")!($P(LASTSUBI,"|",1)="FULLSTR") S SDF="FULLSTR",SDX=SDXT D

 ..S SDREF="B" D PART Q

 .;name as numeric

 .I ($P(LASTSUBI,"|",1)="")!($P(LASTSUBI,"|",1)="FULLNUM"),(+SDXT=SDXT) S SDF="FULLNUM",SDX=SDXT_" " D

 ..S SDREF="B" D PART Q

 .;alb/sat 672 - end modification; separate string and numeric lookup

 ;$O THRU SDEC RESOURCE File

 I SDECP="",'+SDIEN S SDECRES=$S($P(LASTSUBI,"|",2)'="":$P(LASTSUBI,"|",2),1:0) F  S SDECRES=$O(^SDEC(409.831,SDECRES)) Q:'+SDECRES  D  I (+MAXREC)&(SDCNT'<MAXREC) S SDECRES=$O(^SDEC(409.831,SDECRES)) S SDMORE=$S(+SDECRES:1,1:0) Q

 .D RES1

RESX ;

 S SDF=-1 F  S SDF=$O(SDARR(SDF)) Q:SDF=""  D

 .S SDNAM="" F  S SDNAM=$O(SDARR(SDF,SDNAM)) Q:SDNAM=""  D

 ..S SDECI=SDECI+1 S @SDECY@(SDECI)=SDARR(SDF,SDNAM)_$C(30)

 I SDECI>0,'+SDMORE S $P(@SDECY@(SDECI),U,27)=""

 S @SDECY@(SDECI)=@SDECY@(SDECI)_$C(31)

PART  ;partial name lookup  ;alb/sat 672

 Q:SDREF=""

 F  S SDX=$O(^SDEC(409.831,SDREF,SDX)) Q:SDX=""  Q:SDX'[SDECP  D  I (+MAXREC)&(SDCNT'<MAXREC) S SDX=$O(^SDEC(409.831,SDREF,SDX)) S SDMORE=$S(+SDMORE:1,SDX[SDECP:1,1:0) Q

 .S (SDECRES,SDRT)=$S($P(LASTSUBI,"|",3)'="":$P(LASTSUBI,"|",3),1:0)

 .S LASTSUBI="" F  S SDECRES=$O(^SDEC(409.831,SDREF,SDX,SDECRES)) Q:'+SDECRES  D RES1  I (+MAXREC)&(SDCNT'<MAXREC) S SDMORE=+$O(^SDEC(409.831,SDREF,SDX,SDECRES)) Q

RES1 ; get data for 1 resource

 N FND

 S FND=0

 Q:'$D(^SDEC(409.831,SDECRES,0))

 I SDECP'="" S SDH=0 F  S SDH=$O(^SDEC(409.831,"C",SDECP,SDH)) Q:SDH=""  S FND=SDH=SDECRES  Q:FND

 S SDECRNOD=^SDEC(409.831,SDECRES,0)

 I SDTYPE'="" Q:$P(SDECRNOD,U,11)'[SDTYPE

 S SDTYPR=$P(SDECRNOD,U,11)

 S $P(SDTYPR,"|",1)=$S($P(SDTYPR,";",2)="SC(":"H",$P(SDTYPR,";",2)="VA(200,":"P",$P(SDTYPR,";",2)="SDEC(409.834,":"A",1:"")

 S $P(SDTYPR,"|",2)=$P($P(SDECRNOD,U,11),";",1)

 S $P(SDTYPR,"|",3)=$$GET1^DIQ(409.831,SDECRES_",",.012)

 I $P(SDTYPR,"|",1)="P" D RESPRV1^SDEC01B($P(SDTYPR,"|",2),$P(SDECRNOD,U,4))  ;do not include provider resource if NEW PERSON is not active

 I $P(SDTYPR,"|",1)="H" D CHKC^SDEC01B($P(SDTYPR,"|",2),SDECRES)

 I +SDACT,$$GET1^DIQ(409.831,SDECRES_",",.02)="YES" Q   ;do not include inactive entries

 D GETACC(.SDECACC,SDECDUZ,SDECRES)

 ;I SDACT Q:$$GET1^DIQ(409.831,SDECRES_",",.02)'="YES"  ;do not include inactive entries

 K SDECRDAT

 ;alb/sat 658 - begin mod

 S $P(SDECRDAT,U,1)=$P(SDECRNOD,U,1)

 S $P(SDECRDAT,U,2)=$P(SDECRNOD,U,2)

 S $P(SDECRDAT,U,3)=$P(SDECRNOD,U,3)

 S $P(SDECRDAT,U,4)=$P(SDECRNOD,U,4)

 ;F SDEC=1:1:4 S $P(SDECRDAT,U,SDEC)=$P(SDECRNOD,U,SDEC)

 ;alb/sat 658 - end mod

 S SDECRDAT=SDECRES_U_SDECRDAT   ;1,2-5

 S SDCL=$P(SDECRDAT,U,5)

 Q:+$$GET1^DIQ(44,SDCL_",",50.01,"I")=1  ;OOS?

 S PRO=0

 ;MGH code for new type to only contain prohibited clinics

 Q:$G(SDCL)=""&(SDPRO=1)

 Q:$G(SDCL)&(SDPRO=1)&($$GET1^DIQ(44,SDCL_",",2500)'="YES")

 Q:$D(SDARR1(SDECRES))  ;alb/sat 672 - checking for duplicates

 S SDARR1(SDECRES)=""   ;alb/sat 672 - checking for duplicates

 S $P(SDECRDAT,U,3)=$$GET1^DIQ(409.831,SDECRES_",",.02)

 ;Get letter text from wp field

 S SDECLTR=""

 I 0,$D(^SDEC(409.831,SDECRES,1)) D

 . S SDECIEN=0

 . F  S SDECIEN=$O(^SDEC(409.831,SDECRES,1,SDECIEN)) Q:'+SDECIEN  D

 . . S SDECLTR=SDECLTR_$G(^SDEC(409.831,SDECRES,1,SDECIEN,0))

 . . S SDECLTR=SDECLTR_$C(13)_$C(10)

 S SDECNOS=""

 I 0,$D(^SDEC(409.831,SDECRES,12)) D

 . S SDECIEN=0 F  S SDECIEN=$O(^SDEC(409.831,SDECRES,12,SDECIEN)) Q:'+SDECIEN  D

 . . S SDECNOS=SDECNOS_$G(^SDEC(409.831,SDECRES,12,SDECIEN,0))

 . . S SDECNOS=SDECNOS_$C(13)_$C(10)

 S SDECCAN=""

 I 0,$D(^SDEC(409.831,SDECRES,13)) D

 . S SDECIEN=0 F  S SDECIEN=$O(^SDEC(409.831,SDECRES,13,SDECIEN)) Q:'+SDECIEN  D

 . . S SDECCAN=SDECCAN_$G(^SDEC(409.831,SDECRES,13,SDECIEN,0))

 . . S SDECCAN=SDECCAN_$C(13)_$C(10)

 N SDECACC,SDECMGR

 S SDECACC="0^0^0^0"

 S SDECMGR=$O(^DIC(19.1,"B","SDECZMGR",0))

 I +SDECMGR,$D(^VA(200,SDECDUZ,51,SDECMGR)) S SDECACC="1^1^1^1"

 I SDECACC="0^0^0^0" D

 . N SDECNOD,SDECRUID

 . S SDECRUID=0

 . ;Get entry for this user and resource

 . F  S SDECRUID=$O(^SDEC(409.833,"AC",SDECDUZ,SDECRUID)) Q:'+SDECRUID  I $D(^SDEC(409.833,SDECRUID,0)),$P(^(0),U)=SDECRES Q

 . Q:'+SDECRUID

 . S $P(SDECACC,U)=1

 . S SDECNOD=$G(^SDEC(409.833,SDECRUID,0))

 . S $P(SDECACC,U,2)=+$P(SDECNOD,U,3)

 . S $P(SDECACC,U,3)=+$P(SDECNOD,U,4)

 . S $P(SDECACC,U,4)=+$P(SDECNOD,U,5)

 ;                     6         7         8         9-12

 S SDECRDAT=SDECRDAT_U_SDECLTR_U_SDECNOS_U_SDECCAN_U_SDECACC_U_SDTYPR

 ;D GETS^DIQ(409.831,SDECRES_",","**","IE","SDDATA","SDMSG")

 K SDDATA D GETS^DIQ(409.831,SDECRES_",",".01:.04","IE","SDDATA","SDMSG")

 S SDA="SDDATA(409.831,"""_SDECRES_","")"

 S $P(SDECRDAT,U,14)=@SDA@(.015,"E")   ;date/time entered

 S $P(SDECRDAT,U,15)=@SDA@(.016,"I")   ;entered by user id

 S $P(SDECRDAT,U,16)=@SDA@(.016,"E")   ;entered by user name

 S $P(SDECRDAT,U,17)=@SDA@(.021,"E")   ;inactive date/time

 S $P(SDECRDAT,U,18)=@SDA@(.022,"I")   ;inactivated by user ID

 S $P(SDECRDAT,U,19)=@SDA@(.022,"E")   ;inactivated by user name

 S $P(SDECRDAT,U,20)=@SDA@(.025,"E")   ;reactivated date/time

 S $P(SDECRDAT,U,21)=@SDA@(.026,"I")   ;reactivating user ID

 S $P(SDECRDAT,U,22)=@SDA@(.026,"E")   ;reactivating user name

 S $P(SDECRDAT,U,23)=$$GET1^DIQ(44,SDCL_",",.01)  ;clinic name

 S $P(SDECRDAT,U,24)=$S($P(SDTYPR,"|",1)="P":''$O(^SC("AVADPR",+$P(SDTYPR,"|",2),0)),1:0)

 S:$G(SDCL) $P(SDECRDAT,U,25)=$S($G(SDCL):$P($G(^SC(SDCL,"SDPRIV",0)),U,4)>0,1:0)  ;contains privileged users

 S:$G(SDCL) $P(SDECRDAT,U,26)=$$GET1^DIQ(44,SDCL_",",2500)["Y"  ;prohibited clinic

 S $P(SDECRDAT,U,27)=SDF_"|"_SDX_"|"_SDECRES   ;LASTSUB

 S $P(SDECRDAT,U,28)=@SDA@(.011,"E")   ;abbreviation

 S:$P(SDECRDAT,U,23)'="" SDVW=$$GET^XPAR("PKG.SCHEDULING","SDEC VS GUI CLINIC VIEW",$P(SDECRDAT,U,23),"B")   ;alb/sat 672

 S $P(SDECRDAT,U,29)=$S(SDVW'="":$P(SDVW,U,1),1:"W")  ;alb/sat 672

 S $P(SDECRDAT,U,2)=$S(($G(SDF)["ABBR")&(@SDA@(.011,"E")'=""):@SDA@(.011,"E")_" ",1:"")_$P(SDECRDAT,U,2)  ;alb/sat 658 - include abbr in name if found by C xref

 S CLINICIEN=$$GET1^DIQ(409.831,SDECRES,.04,"I")

 S TIMEZONE=$$TIMEZONEDATA^SDESUTIL(CLINICIEN)

 S $P(SDECRDAT,U,30)=$P($G(TIMEZONE),U)

 S SDARR(SDF["FULL",$P(SDECRDAT,U,2))=SDECRDAT,SDCNT=SDCNT+1

GETACC(SDECACC,SDECDUZ,SDECRES) ;get view, overbook, modify appt, and modify schedule abilities

 ;INPUT:

 ; SDECDUZ = user ID pointer to NEW PERSON file

 ; SDECRES = resource ID pointer to SDEC RESOURCE file

 ;RETURN:

 ; .SDECACC  = access separated by ^:

 ;   1. VIEW - User can VIEW 1=YES; 0=NO

 ;   2. OVERBOOK - User can OVERBOOK  1=YES; 0=NO

 ;   3. MODIFY SCHEDULE - User can Modify Schedule  1=YES; 0=NO

 ;   4. MODIFY APPOINTMENTS User can modify appointments  1=YES; 0=NO

 N SDECMGR

 S SDECACC="0^0^0^0"

 S SDECMGR=$O(^DIC(19.1,"B","SDECZMGR",0))

 I +SDECMGR,$D(^VA(200,SDECDUZ,51,SDECMGR)) S SDECACC="1^1^1^1"

 I SDECACC="0^0^0^0" D

 . N SDECNOD,SDECRUID

 . S SDECRUID=0

 . ;Get entry for this user and resource

 . F  S SDECRUID=$O(^SDEC(409.833,"AC",SDECDUZ,SDECRUID)) Q:'+SDECRUID  I $D(^SDEC(409.833,SDECRUID,0)),$P(^(0),U)=SDECRES Q

 . Q:'+SDECRUID

 . S $P(SDECACC,U)=1

 . S SDECNOD=$G(^SDEC(409.833,SDECRUID,0))

 . S $P(SDECACC,U,2)=+$P(SDECNOD,U,3)

 . S $P(SDECACC,U,3)=+$P(SDECNOD,U,4)

 . S $P(SDECACC,U,4)=+$P(SDECNOD,U,5)

GETLTRS(SDECLTR,SDECNOS,SDECCAN,SDECRES,SDCL) ;get resource letters

 ;INPUT:

 ; SDECRES = resource ID pointer to SDEC RESOURCE file

 ; SDCL    = clinic ID pointer to HOSPITAL LOCATION file

 ;RETURN:

 ; .SDECLTR = LETTER TEXT

 ; .SDECNOS = NO SHOW LETTER

 ; .SDECCAN = CLINIC CANCELLATION LETTER

 ; .Get letter text from wp field

 N SDECIEN

 S SDECLTR=""

 I $D(^SDEC(409.831,SDECRES,2,SDCL,1)) D

 . S SDECIEN=0 F  S SDECIEN=$O(^SDEC(409.831,SDECRES,2,SDCL,1,SDECIEN)) Q:'+SDECIEN  D

 . . S SDECLTR=SDECLTR_$G(^SDEC(409.831,SDECRES,2,SDCL,1,SDECIEN,0))

 . . S SDECLTR=SDECLTR_$C(13)_$C(10)

 S SDECNOS=""

 I $D(^SDEC(409.831,SDECRES,2,SDCL,12)) D

 . S SDECIEN=0 F  S SDECIEN=$O(^SDEC(409.831,SDECRES,2,SDCL,12,SDECIEN)) Q:'+SDECIEN  D

 . . S SDECNOS=SDECNOS_$G(^SDEC(409.831,SDECRES,2,SDCL,12,SDECIEN,0))

 . . S SDECNOS=SDECNOS_$C(13)_$C(10)

 S SDECCAN=""

 I $D(^SDEC(409.831,SDECRES,13)) D

 . S SDECIEN=0 F  S SDECIEN=$O(^SDEC(409.831,SDECRES,2,SDCL,13,SDECIEN)) Q:'+SDECIEN  D

 . . S SDECCAN=SDECCAN_$G(^SDEC(409.831,SDECRES,2,SDCL,13,SDECIEN,0))

 . . S SDECCAN=SDECCAN_$C(13)_$C(10)

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDEC01A   14977     printed  Feb 19, 2025@00:16:15                                                                                                                                                                                                    Page 2

SDEC01A   ;ALB/SAT,BLB - VISTA SCHEDULING RPCS ;MAR 14, 2022

 +1       ;;5.3;Scheduling;**627,642,658,665,672,809**;Aug 13, 1993;Build 10

 +2       ;

 +3        QUIT

 +4       ;

RESOURCE(SDECY,SDECDUZ,SDACT,SDTYPE,MAXREC,LASTSUBI,SDIEN,SDECP) ;Returns ADO Recordset with ALL RESOURCE names

 +1       ;   SDECDUZ = (optional) pointer to NEW PERSON file

 +2       ;                       Defaults to current user

 +3       ;                       checks that overbook is allowed

 +4       ;   SDACT   = (optional) 1 or YES will return only active resources

 +5       ;                       0, NO, or null will include inactive

 +6       ;   SDTYPE    = (optional) null will return all resource types

 +7       ;            H will only return HOSPITAL LOCATION (clinic) resources

 +8       ;            P will only return NEW PERSON (Provider) resources

 +9       ;            A will only return SDEC ADDITIONAL RESOURCE resources

 +10      ;            PH will only return prohibited clinics

 +11      ;   MAXREC   - (optional) Max records returned

 +12      ;   LASTSUBI - (optional) last subscripts from previous call

 +13      ;   SDIEN    - (optional) pointer to SDEC RESOURCE file

 +14      ;                         only 1 record will be returned if SDIEN is present

 +15      ;   SDECP  - (optional) Partial name text

 +16      ;RETURN:

 +17      ;  Successful Return:

 +18      ;   a global array in which each array entry contains data from the

 +19      ;      SDEC RESOURCE file

 +20      ;   1. RESOURCEID - Pointer to the SDEC RESOURCE file

 +21      ;   2. RESOURCE_NAME - NAME from SDEC RESOURCE file

 +22      ;   3. INACTIVE   - inactive Clinic - Returned values will be NO YES

 +23      ;   4. TIMESCALE - Valid Values:

 +24      ;                    5, 10, 15, 20, 30, 60

 +25      ;   5. HOSPITAL_LOCATION_ID

 +26      ;   6. <NOT USED> LETTER_TEXT

 +27      ;   7. <NOT USED> NO_SHOW_LETTER

 +28      ;   8. <NOT USED> CLINIC_CANCELLATION_LETTER

 +29      ;   9. VIEW - User can VIEW 1=YES; 0=NO

 +30      ;  10. OVERBOOK - User can OVERBOOK  1=YES; 0=NO

 +31      ;  11. MODIFY_SCHEDULE - User can Modify Schedule  1=YES; 0=NO

 +32      ;  12. MODIFY_APPOINTMENTS User can modify appointments  1=YES; 0=NO

 +33      ;  13. RESOURCETYPE - 3 pipe pieces:

 +34      ;          1. type H, P, or A

 +35      ;          2. IEN - pointer to [H] HOSPITAL LOCATION, [P] NEW PERSON,

 +36      ;                   or [A] SDEC ADDITIONAL RESOURCE file

 +37      ;          3. Name - name from the appropriate type file

 +38      ;  14. DATE      - Date/Time entered in external format

 +39      ;  15. USERIEN   - Entered By User ID pointer to NEW PERSON file 200

 +40      ;  16. USERNAME  - Entered By User name from NEW PERSON file

 +41      ;  17. DATE1     - Inactive Date/Time in external format

 +42      ;  18. USERIEN1  - Inactivating User ID pointer to NEW PERSON file

 +43      ;  19. USERNAME1 - Inactivating User Name from NEW PERSON file

 +44      ;  20. DATE2     - Reactivated Date/Time in external format

 +45      ;  21. USERIEN2  - Reactivating User ID pointer to NEW PERSON file

 +46      ;  22. USERNAME2 - Reactivating User Name from NEW PERSON file

 +47      ;  23. CLINNAME  - Clinic Name from HOSPITAL LOCATION file 44

 +48      ;  24. PROVCLIN  - Boolean indicating 'this' P type resource is a provider for a clinic

 +49      ;                  0  = not a provider (not found in the AVADPR index for file 44)

 +50      ;                  1  = is a provider

 +51      ;  25. PRIVLOC   - Boolean indicating presence of privileged users for hospital location

 +52      ;  26. PRHBLOC   - Boolean indicating if location is a Prohibit Access clinic

 +53      ;  27. LASTSUB   - Last subscript in return data. Used in next call to

 +54      ;                  SDEC RESOURCE to get additional records

 +55      ;  28. ABBR      - Abbreviation

 +56      ;

 +57      ;

 +58       NEW SDA,SDCL,SDDATA,SDMSG,SDECERR,SDECRET,SDECIEN,SDECRES,SDECDEP,SDECDDR,SDECDEPN,SDECRDAT,SDECRNOD,SDECI,SDEC,SDECLTR

 +59       NEW ABBR,SDECNOS,SDECCAN,SDF,SDTYPR,SDX,SDPRO,PRO,SDH,SDK,SDRT,SDT,SDXT,TIMEZONE,CLINICIEN

 +60      ;alb/sat 665  ;alb/sat 672 add SDARR1,SDREF

           NEW SDARR,SDARR1,SDCNT,SDMORE,SDNAM,SDREF

 +61      ;alb/sat 672

           NEW SDVW

 +62       SET (SDRT,SDT,SDX)=""

           SET SDPRO=0

 +63       SET (SDCNT,SDF,SDMORE)=0

 +64      ;alb/sat 672

           SET SDVW=""

 +65       SET SDECY="^TMP(""SDEC01A"","_$JOB_",""RESOURCE"")"

 +66       KILL @SDECY

 +67       SET SDECI=0

 +68       SET (SDECERR,SDTYPR)=""

 +69      ;                       1                2                   3              4               5                          6                 7

 +70       SET @SDECY@(SDECI)="I00010RESOURCEID^T00030RESOURCE_NAME^T00010INACTIVE^I00010TIMESCALE^I00010HOSPITAL_LOCATION_ID^T00030LETTER_TEXT^T00030NO_SHOW_LETTER"

 +71      ;                                 8                                9          10             11                    12

 +72       SET @SDECY@(SDECI)=^(SDECI)_"^T00030CLINIC_CANCELLATION_LETTER^I00010VIEW^I00010OVERBOOK^I00010MODIFY_SCHEDULE^I00010MODIFY_APPOINTMENTS"

 +73      ;                                 13                 14         15            16

 +74       SET @SDECY@(SDECI)=^(SDECI)_"^T00030RESOURCETYPE^T00030DATE^T00030USERIEN^T00030USERNAME"

 +75      ;                                 17          18             19              20          21             22

 +76       SET @SDECY@(SDECI)=^(SDECI)_"^T00030DATE1^T00030USERIEN1^T00030USERNAME1^T00030DATE2^T00030USERIEN2^T00030USERNAME2"

 +77      ;                                 23             24           25              26            27

 +78       SET @SDECY@(SDECI)=^(SDECI)_"^T00030CLINNAME^T00030PROVCLIN^T00030PRIVLOC^T00030PRHBLOC^T00030LASTSUB^T00030ABBR"

 +79      ;alb/sat 672 - add DEFAULT_VIEW

           SET @SDECY@(SDECI)=^(SDECI)_"^T00030DEFAULT_VIEW^T00030TIMEZONE"_$CHAR(30)

 +80      ;validate user

 +81       SET SDECDUZ=$GET(SDECDUZ)

 +82       IF '+SDECDUZ

               SET SDECDUZ=DUZ

 +83      ;validate active

 +84       SET SDACT=$GET(SDACT)

 +85       SET SDACT=$SELECT(SDACT=1:1,SDACT="YES":1,1:0)

 +86      ;validate type

 +87       SET SDTYPE=$GET(SDTYPE)

 +88      ;MGH added new type

 +89       IF SDTYPE="PH"

               SET SDPRO=1

 +90       SET SDTYPE=$SELECT(SDTYPE="H":"SC(",SDTYPE="P":"VA(200",SDTYPE="A":"SDEC",1:"")

 +91      ;validate MAXREC

 +92       SET MAXREC=$GET(MAXREC,9999999)

 +93      ;validate LASTSUBI

 +94       SET LASTSUBI=$GET(LASTSUBI)

 +95      ;validate SDIEN

 +96      ;MGH changed to allow multiple IENS

 +97      ;S SDIEN=$G(SDIEN)

 +98      ;I SDIEN'="",'$D(^SDEC(409.831,+SDIEN,0)) S SDIEN=""

 +99       IF $GET(SDIEN)

               Begin DoDot:1

 +100              FOR SDK=1:1:$LENGTH(SDIEN,"|")

                       Begin DoDot:2

 +101                      SET SDECIEN=$PIECE(SDIEN,"|",SDK)

 +102                      if '$DATA(^SDEC(409.831,+SDECIEN,0))

                               QUIT

 +103                      SET SDECRES=SDECIEN

 +104                      DO RES1

                       End DoDot:2

               End DoDot:1

               GOTO RESX

 +105     ;ien lookup

 +106     ;I +SDIEN S SDECRES=+SDIEN D RES1 G RESX

 +107     ;validate SDECP

 +108      SET SDECP=$GET(SDECP)

 +109     ;partial name lookup

 +110      IF SDECP'=""

               Begin DoDot:1

 +111              SET SDF=$SELECT($PIECE(LASTSUBI,"|",1)'="":$PIECE(LASTSUBI,"|",1),1:"")

 +112     ;alb/sat 672 - begin modification; separate string and numeric lookup

 +113              SET (SDX,SDXT)=$SELECT($PIECE(LASTSUBI,"|",2)'="":$$GETSUB^SDECU($PIECE(LASTSUBI,"|",2)),1:$$GETSUB^SDECU(SDECP))

 +114     ;abbreviation as string

 +115              IF ($PIECE(LASTSUBI,"|",1)="")!($PIECE(LASTSUBI,"|",1)="ABBRSTR")

                       SET SDF="ABBRSTR"

                       Begin DoDot:2

 +116                      SET SDREF="C"

                           DO PART

                           QUIT

                       End DoDot:2

 +117     ;abbreviation as numeric

 +118              IF ($PIECE(LASTSUBI,"|",1)="")!($PIECE(LASTSUBI,"|",1)="ABBRNUM")

                       IF (+SDXT=SDXT)

                           SET SDF="ABBRNUM"

                           SET SDX=SDXT_" "

                           Begin DoDot:2

 +119                          SET SDREF="C"

                               DO PART

                               QUIT

                           End DoDot:2

 +120     ;name as string

 +121              IF ($PIECE(LASTSUBI,"|",1)="")!($PIECE(LASTSUBI,"|",1)="FULLSTR")

                       SET SDF="FULLSTR"

                       SET SDX=SDXT

                       Begin DoDot:2

 +122                      SET SDREF="B"

                           DO PART

                           QUIT

                       End DoDot:2

 +123     ;name as numeric

 +124              IF ($PIECE(LASTSUBI,"|",1)="")!($PIECE(LASTSUBI,"|",1)="FULLNUM")

                       IF (+SDXT=SDXT)

                           SET SDF="FULLNUM"

                           SET SDX=SDXT_" "

                           Begin DoDot:2

 +125                          SET SDREF="B"

                               DO PART

                               QUIT

                           End DoDot:2

 +126     ;alb/sat 672 - end modification; separate string and numeric lookup

               End DoDot:1

 +127     ;$O THRU SDEC RESOURCE File

 +128      IF SDECP=""

               IF '+SDIEN

                   SET SDECRES=$SELECT($PIECE(LASTSUBI,"|",2)'="":$PIECE(LASTSUBI,"|",2),1:0)

FOR

                       SET SDECRES=$ORDER(^SDEC(409.831,SDECRES))

                       if '+SDECRES

                           QUIT

                       Begin DoDot:1

 +129                      DO RES1

                       End DoDot:1

                       IF (+MAXREC)&(SDCNT'<MAXREC)

                           SET SDECRES=$ORDER(^SDEC(409.831,SDECRES))

                           SET SDMORE=$SELECT(+SDECRES:1,1:0)

                           QUIT

RESX      ;

 +1        SET SDF=-1

FOR

               SET SDF=$ORDER(SDARR(SDF))

               if SDF=""

                   QUIT

               Begin DoDot:1

 +2                SET SDNAM=""

FOR

                       SET SDNAM=$ORDER(SDARR(SDF,SDNAM))

                       if SDNAM=""

                           QUIT

                       Begin DoDot:2

 +3                        SET SDECI=SDECI+1

                           SET @SDECY@(SDECI)=SDARR(SDF,SDNAM)_$CHAR(30)

                       End DoDot:2

               End DoDot:1

 +4        IF SDECI>0

               IF '+SDMORE

                   SET $PIECE(@SDECY@(SDECI),U,27)=""

 +5        SET @SDECY@(SDECI)=@SDECY@(SDECI)_$CHAR(31)

 +6        QUIT

PART      ;partial name lookup  ;alb/sat 672

 +1        if SDREF=""

               QUIT

 +2        FOR

               SET SDX=$ORDER(^SDEC(409.831,SDREF,SDX))

               if SDX=""

                   QUIT

               if SDX'[SDECP

                   QUIT

               Begin DoDot:1

 +3                SET (SDECRES,SDRT)=$SELECT($PIECE(LASTSUBI,"|",3)'="":$PIECE(LASTSUBI,"|",3),1:0)

 +4                SET LASTSUBI=""

FOR

                       SET SDECRES=$ORDER(^SDEC(409.831,SDREF,SDX,SDECRES))

                       if '+SDECRES

                           QUIT

                       DO RES1

                       IF (+MAXREC)&(SDCNT'<MAXREC)

                           SET SDMORE=+$ORDER(^SDEC(409.831,SDREF,SDX,SDECRES))

                           QUIT

               End DoDot:1

               IF (+MAXREC)&(SDCNT'<MAXREC)

                   SET SDX=$ORDER(^SDEC(409.831,SDREF,SDX))

                   SET SDMORE=$SELECT(+SDMORE:1,SDX[SDECP:1,1:0)

                   QUIT

 +5        QUIT

RES1      ; get data for 1 resource

 +1        NEW FND

 +2        SET FND=0

 +3        if '$DATA(^SDEC(409.831,SDECRES,0))

               QUIT

 +4        IF SDECP'=""

               SET SDH=0

FOR

                   SET SDH=$ORDER(^SDEC(409.831,"C",SDECP,SDH))

                   if SDH=""

                       QUIT

                   SET FND=SDH=SDECRES

                   if FND

                       QUIT

 +5        SET SDECRNOD=^SDEC(409.831,SDECRES,0)

 +6        IF SDTYPE'=""

               if $PIECE(SDECRNOD,U,11)'[SDTYPE

                   QUIT

 +7        SET SDTYPR=$PIECE(SDECRNOD,U,11)

 +8        SET $PIECE(SDTYPR,"|",1)=$SELECT($PIECE(SDTYPR,";",2)="SC(":"H",$PIECE(SDTYPR,";",2)="VA(200,":"P",$PIECE(SDTYPR,";",2)="SDEC(409.834,":"A",1:"")

 +9        SET $PIECE(SDTYPR,"|",2)=$PIECE($PIECE(SDECRNOD,U,11),";",1)

 +10       SET $PIECE(SDTYPR,"|",3)=$$GET1^DIQ(409.831,SDECRES_",",.012)

 +11      ;do not include provider resource if NEW PERSON is not active

           IF $PIECE(SDTYPR,"|",1)="P"

               DO RESPRV1^SDEC01B($PIECE(SDTYPR,"|",2),$PIECE(SDECRNOD,U,4))

 +12       IF $PIECE(SDTYPR,"|",1)="H"

               DO CHKC^SDEC01B($PIECE(SDTYPR,"|",2),SDECRES)

 +13      ;do not include inactive entries

           IF +SDACT

               IF $$GET1^DIQ(409.831,SDECRES_",",.02)="YES"

                   QUIT

 +14       DO GETACC(.SDECACC,SDECDUZ,SDECRES)

 +15      ;I SDACT Q:$$GET1^DIQ(409.831,SDECRES_",",.02)'="YES"  ;do not include inactive entries

 +16       KILL SDECRDAT

 +17      ;alb/sat 658 - begin mod

 +18       SET $PIECE(SDECRDAT,U,1)=$PIECE(SDECRNOD,U,1)

 +19       SET $PIECE(SDECRDAT,U,2)=$PIECE(SDECRNOD,U,2)

 +20       SET $PIECE(SDECRDAT,U,3)=$PIECE(SDECRNOD,U,3)

 +21       SET $PIECE(SDECRDAT,U,4)=$PIECE(SDECRNOD,U,4)

 +22      ;F SDEC=1:1:4 S $P(SDECRDAT,U,SDEC)=$P(SDECRNOD,U,SDEC)

 +23      ;alb/sat 658 - end mod

 +24      ;1,2-5

           SET SDECRDAT=SDECRES_U_SDECRDAT

 +25       SET SDCL=$PIECE(SDECRDAT,U,5)

 +26      ;OOS?

           if +$$GET1^DIQ(44,SDCL_",",50.01,"I")=1

               QUIT

 +27       SET PRO=0

 +28      ;MGH code for new type to only contain prohibited clinics

 +29       if $GET(SDCL)=""&(SDPRO=1)

               QUIT

 +30       if $GET(SDCL)&(SDPRO=1)&($$GET1^DIQ(44,SDCL_",",2500)'="YES")

               QUIT

 +31      ;alb/sat 672 - checking for duplicates

           if $DATA(SDARR1(SDECRES))

               QUIT

 +32      ;alb/sat 672 - checking for duplicates

           SET SDARR1(SDECRES)=""

 +33       SET $PIECE(SDECRDAT,U,3)=$$GET1^DIQ(409.831,SDECRES_",",.02)

 +34      ;Get letter text from wp field

 +35       SET SDECLTR=""

 +36       IF 0

               IF $DATA(^SDEC(409.831,SDECRES,1))

                   Begin DoDot:1

 +37                   SET SDECIEN=0

 +38                   FOR

                           SET SDECIEN=$ORDER(^SDEC(409.831,SDECRES,1,SDECIEN))

                           if '+SDECIEN

                               QUIT

                           Begin DoDot:2

 +39                           SET SDECLTR=SDECLTR_$GET(^SDEC(409.831,SDECRES,1,SDECIEN,0))

 +40                           SET SDECLTR=SDECLTR_$CHAR(13)_$CHAR(10)

                           End DoDot:2

                   End DoDot:1

 +41       SET SDECNOS=""

 +42       IF 0

               IF $DATA(^SDEC(409.831,SDECRES,12))

                   Begin DoDot:1

 +43                   SET SDECIEN=0

FOR

                           SET SDECIEN=$ORDER(^SDEC(409.831,SDECRES,12,SDECIEN))

                           if '+SDECIEN

                               QUIT

                           Begin DoDot:2

 +44                           SET SDECNOS=SDECNOS_$GET(^SDEC(409.831,SDECRES,12,SDECIEN,0))

 +45                           SET SDECNOS=SDECNOS_$CHAR(13)_$CHAR(10)

                           End DoDot:2

                   End DoDot:1

 +46       SET SDECCAN=""

 +47       IF 0

               IF $DATA(^SDEC(409.831,SDECRES,13))

                   Begin DoDot:1

 +48                   SET SDECIEN=0

FOR

                           SET SDECIEN=$ORDER(^SDEC(409.831,SDECRES,13,SDECIEN))

                           if '+SDECIEN

                               QUIT

                           Begin DoDot:2

 +49                           SET SDECCAN=SDECCAN_$GET(^SDEC(409.831,SDECRES,13,SDECIEN,0))

 +50                           SET SDECCAN=SDECCAN_$CHAR(13)_$CHAR(10)

                           End DoDot:2

                   End DoDot:1

 +51       NEW SDECACC,SDECMGR

 +52       SET SDECACC="0^0^0^0"

 +53       SET SDECMGR=$ORDER(^DIC(19.1,"B","SDECZMGR",0))

 +54       IF +SDECMGR

               IF $DATA(^VA(200,SDECDUZ,51,SDECMGR))

                   SET SDECACC="1^1^1^1"

 +55       IF SDECACC="0^0^0^0"

               Begin DoDot:1

 +56               NEW SDECNOD,SDECRUID

 +57               SET SDECRUID=0

 +58      ;Get entry for this user and resource

 +59               FOR

                       SET SDECRUID=$ORDER(^SDEC(409.833,"AC",SDECDUZ,SDECRUID))

                       if '+SDECRUID

                           QUIT

                       IF $DATA(^SDEC(409.833,SDECRUID,0))

                           IF $PIECE(^(0),U)=SDECRES

                               QUIT

 +60               if '+SDECRUID

                       QUIT

 +61               SET $PIECE(SDECACC,U)=1

 +62               SET SDECNOD=$GET(^SDEC(409.833,SDECRUID,0))

 +63               SET $PIECE(SDECACC,U,2)=+$PIECE(SDECNOD,U,3)

 +64               SET $PIECE(SDECACC,U,3)=+$PIECE(SDECNOD,U,4)

 +65               SET $PIECE(SDECACC,U,4)=+$PIECE(SDECNOD,U,5)

               End DoDot:1

 +66      ;                     6         7         8         9-12

 +67       SET SDECRDAT=SDECRDAT_U_SDECLTR_U_SDECNOS_U_SDECCAN_U_SDECACC_U_SDTYPR

 +68      ;D GETS^DIQ(409.831,SDECRES_",","**","IE","SDDATA","SDMSG")

 +69       KILL SDDATA

           DO GETS^DIQ(409.831,SDECRES_",",".01:.04","IE","SDDATA","SDMSG")

 +70       SET SDA="SDDATA(409.831,"""_SDECRES_","")"

 +71      ;date/time entered

           SET $PIECE(SDECRDAT,U,14)=@SDA@(.015,"E")

 +72      ;entered by user id

           SET $PIECE(SDECRDAT,U,15)=@SDA@(.016,"I")

 +73      ;entered by user name

           SET $PIECE(SDECRDAT,U,16)=@SDA@(.016,"E")

 +74      ;inactive date/time

           SET $PIECE(SDECRDAT,U,17)=@SDA@(.021,"E")

 +75      ;inactivated by user ID

           SET $PIECE(SDECRDAT,U,18)=@SDA@(.022,"I")

 +76      ;inactivated by user name

           SET $PIECE(SDECRDAT,U,19)=@SDA@(.022,"E")

 +77      ;reactivated date/time

           SET $PIECE(SDECRDAT,U,20)=@SDA@(.025,"E")

 +78      ;reactivating user ID

           SET $PIECE(SDECRDAT,U,21)=@SDA@(.026,"I")

 +79      ;reactivating user name

           SET $PIECE(SDECRDAT,U,22)=@SDA@(.026,"E")

 +80      ;clinic name

           SET $PIECE(SDECRDAT,U,23)=$$GET1^DIQ(44,SDCL_",",.01)

 +81       SET $PIECE(SDECRDAT,U,24)=$SELECT($PIECE(SDTYPR,"|",1)="P":''$ORDER(^SC("AVADPR",+$PIECE(SDTYPR,"|",2),0)),1:0)

 +82      ;contains privileged users

           if $GET(SDCL)

               SET $PIECE(SDECRDAT,U,25)=$SELECT($GET(SDCL):$PIECE($GET(^SC(SDCL,"SDPRIV",0)),U,4)>0,1:0)

 +83      ;prohibited clinic

           if $GET(SDCL)

               SET $PIECE(SDECRDAT,U,26)=$$GET1^DIQ(44,SDCL_",",2500)["Y"

 +84      ;LASTSUB

           SET $PIECE(SDECRDAT,U,27)=SDF_"|"_SDX_"|"_SDECRES

 +85      ;abbreviation

           SET $PIECE(SDECRDAT,U,28)=@SDA@(.011,"E")

 +86      ;alb/sat 672

           if $PIECE(SDECRDAT,U,23)'=""

               SET SDVW=$$GET^XPAR("PKG.SCHEDULING","SDEC VS GUI CLINIC VIEW",$PIECE(SDECRDAT,U,23),"B")

 +87      ;alb/sat 672

           SET $PIECE(SDECRDAT,U,29)=$SELECT(SDVW'="":$PIECE(SDVW,U,1),1:"W")

 +88      ;alb/sat 658 - include abbr in name if found by C xref

           SET $PIECE(SDECRDAT,U,2)=$SELECT(($GET(SDF)["ABBR")&(@SDA@(.011,"E")'=""):@SDA@(.011,"E")_" ",1:"")_$PIECE(SDECRDAT,U,2)

 +89       SET CLINICIEN=$$GET1^DIQ(409.831,SDECRES,.04,"I")

 +90       SET TIMEZONE=$$TIMEZONEDATA^SDESUTIL(CLINICIEN)

 +91       SET $PIECE(SDECRDAT,U,30)=$PIECE($GET(TIMEZONE),U)

 +92       SET SDARR(SDF["FULL",$PIECE(SDECRDAT,U,2))=SDECRDAT

           SET SDCNT=SDCNT+1

 +93       QUIT

 +94      ;

GETACC(SDECACC,SDECDUZ,SDECRES) ;get view, overbook, modify appt, and modify schedule abilities

 +1       ;INPUT:

 +2       ; SDECDUZ = user ID pointer to NEW PERSON file

 +3       ; SDECRES = resource ID pointer to SDEC RESOURCE file

 +4       ;RETURN:

 +5       ; .SDECACC  = access separated by ^:

 +6       ;   1. VIEW - User can VIEW 1=YES; 0=NO

 +7       ;   2. OVERBOOK - User can OVERBOOK  1=YES; 0=NO

 +8       ;   3. MODIFY SCHEDULE - User can Modify Schedule  1=YES; 0=NO

 +9       ;   4. MODIFY APPOINTMENTS User can modify appointments  1=YES; 0=NO

 +10       NEW SDECMGR

 +11       SET SDECACC="0^0^0^0"

 +12       SET SDECMGR=$ORDER(^DIC(19.1,"B","SDECZMGR",0))

 +13       IF +SDECMGR

               IF $DATA(^VA(200,SDECDUZ,51,SDECMGR))

                   SET SDECACC="1^1^1^1"

 +14       IF SDECACC="0^0^0^0"

               Begin DoDot:1

 +15               NEW SDECNOD,SDECRUID

 +16               SET SDECRUID=0

 +17      ;Get entry for this user and resource

 +18               FOR

                       SET SDECRUID=$ORDER(^SDEC(409.833,"AC",SDECDUZ,SDECRUID))

                       if '+SDECRUID

                           QUIT

                       IF $DATA(^SDEC(409.833,SDECRUID,0))

                           IF $PIECE(^(0),U)=SDECRES

                               QUIT

 +19               if '+SDECRUID

                       QUIT

 +20               SET $PIECE(SDECACC,U)=1

 +21               SET SDECNOD=$GET(^SDEC(409.833,SDECRUID,0))

 +22               SET $PIECE(SDECACC,U,2)=+$PIECE(SDECNOD,U,3)

 +23               SET $PIECE(SDECACC,U,3)=+$PIECE(SDECNOD,U,4)

 +24               SET $PIECE(SDECACC,U,4)=+$PIECE(SDECNOD,U,5)

               End DoDot:1

 +25       QUIT

 +26      ;

GETLTRS(SDECLTR,SDECNOS,SDECCAN,SDECRES,SDCL) ;get resource letters

 +1       ;INPUT:

 +2       ; SDECRES = resource ID pointer to SDEC RESOURCE file

 +3       ; SDCL    = clinic ID pointer to HOSPITAL LOCATION file

 +4       ;RETURN:

 +5       ; .SDECLTR = LETTER TEXT

 +6       ; .SDECNOS = NO SHOW LETTER

 +7       ; .SDECCAN = CLINIC CANCELLATION LETTER

 +8       ; .Get letter text from wp field

 +9        NEW SDECIEN

 +10       SET SDECLTR=""

 +11       IF $DATA(^SDEC(409.831,SDECRES,2,SDCL,1))

               Begin DoDot:1

 +12               SET SDECIEN=0

FOR

                       SET SDECIEN=$ORDER(^SDEC(409.831,SDECRES,2,SDCL,1,SDECIEN))

                       if '+SDECIEN

                           QUIT

                       Begin DoDot:2

 +13                       SET SDECLTR=SDECLTR_$GET(^SDEC(409.831,SDECRES,2,SDCL,1,SDECIEN,0))

 +14                       SET SDECLTR=SDECLTR_$CHAR(13)_$CHAR(10)

                       End DoDot:2

               End DoDot:1

 +15       SET SDECNOS=""

 +16       IF $DATA(^SDEC(409.831,SDECRES,2,SDCL,12))

               Begin DoDot:1

 +17               SET SDECIEN=0

FOR

                       SET SDECIEN=$ORDER(^SDEC(409.831,SDECRES,2,SDCL,12,SDECIEN))

                       if '+SDECIEN

                           QUIT

                       Begin DoDot:2

 +18                       SET SDECNOS=SDECNOS_$GET(^SDEC(409.831,SDECRES,2,SDCL,12,SDECIEN,0))

 +19                       SET SDECNOS=SDECNOS_$CHAR(13)_$CHAR(10)

                       End DoDot:2

               End DoDot:1

 +20       SET SDECCAN=""

 +21       IF $DATA(^SDEC(409.831,SDECRES,13))

               Begin DoDot:1

 +22               SET SDECIEN=0

FOR

                       SET SDECIEN=$ORDER(^SDEC(409.831,SDECRES,2,SDCL,13,SDECIEN))

                       if '+SDECIEN

                           QUIT

                       Begin DoDot:2

 +23                       SET SDECCAN=SDECCAN_$GET(^SDEC(409.831,SDECRES,2,SDCL,13,SDECIEN,0))

 +24                       SET SDECCAN=SDECCAN_$CHAR(13)_$CHAR(10)

                       End DoDot:2

               End DoDot:1

 +25       QUIT

SDEC01A.m