SDEC01A ;ALB/SAT,BLB - VISTA SCHEDULING RPCS ;MAR 14, 2022
;;5.3;Scheduling;**627,642,658,665,672,809**;Aug 13, 1993;Build 10
;
Q
;
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)
Q
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
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
Q
;
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)
Q
;
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)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDEC01A 14977 printed Dec 13, 2024@02:49:49 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
