SDEC16 ;ALB/SAT - VISTA SCHEDULING RPCS ;JAN 15, 2016
;;5.3;Scheduling;**627**;Aug 13, 1993;Build 249
;
Q
;
ADDRES(SDECY,SDECVAL) ;ADD/EDIT RESOURCE
;ADDRES(SDECY,SDECVAL) external parameter tag is in SDEC
;Add/Edit SDEC RESOURCE entry
;INPUT:
; SDECVAL - ResourceID|ResourceName|<NOT USED>|HospLocID|TIME_SCALE
; |LETTER_TEXT|NO_SHOW_LETTER|CANCELLATION_LETTER
; | INACTIVATEDDT | INACTIVATEDUSR | REACTIVATEDDT
; | REACTIVATEDUSR | RESOURCETYPE | RESOURCETYPEIEN
; 1. ResourceID - (optional) Pointer to the SDEC RESOURCE file
; a new entry is added if IEN is 0
; 2. ResourceName - (required) Value put into the RESOURCE field
; of the SDEC RESOURCE file
; 3. NOT USED INACTIVE This is 'computed' based on inactivation
; and reactivation fields
; 4. HospLocID - (required) Hospital Location ID - pointer to the
; HOSPITAL LOCATION file 44
; 5. TIME_SCALE - (optional) Value put into the TIME SCALE field
; of the SDEC RESOURCE file
; Allowed values: 5 10 15 20 30 60
; 6. LETTER_TEXT - (optional) Value converted to Word Processor and
; put into the LETTER TEXT field of the
; SDEC RESOURCE file
; 7. NO_SHOW_LETTER - (optional) Value converted to Word Processor
; and put into the NO SHOW LETTER field of
; the SDEC RESOURCE file
; 8. CANCELLATION_LETTER - (optional) Value converted to
; Word Processor and put into the CLINIC
; CANCELLATION LETTER field
; of the SDEC RESOURCE file
; 9. DATE/TIME - (optional) DATE/TIME entered in external format
; Defaults to NOW.
; 10. ENTEREDBY - (optional) Entered by User pointer to NEW PERSON
; Defaults to current user
; 11. INACTIVATEDDT - (optional) inactivated Date/Time external format
; 12. INACTIVATEDUSR- (optional) inactivating user pointer to
; NEW PERSON file
; 13. REACTIVATEDDT - (optional) reactivated Date/Time external format
; 14. REACTIVATEDUSR- (optional) reactivating user pointer to
; NEW PERSON file
; 15. RESOURCETYPE - (required) valid values are:
; H for HOSPITAL LOCATION (or clinic)
; P for NEW PERSON (Provider)
; A for ADDITIONAL RESOURCE
; 16. RESOURCETYPEIEN - (required) pointer to 1 of the following:
; HOSPITAL LOCATION file
; NEW PERSON file
; ADDITIONAL RESOURCE file
;RETURN:
; SDEC RESOURCE ien
;
;
N SDECIENS,SDECFDA,SDECIEN,SDECMSG,SDEC,SDECINA,SDECNOTE,SDECNAM
N SDEDT,SDEUSR,SDIDT,SDIUSR,SDRDT,SDRUSR,SDREST,SDRESTID
N %DT,X,Y
S SDECY="^TMP(""SDEC"","_$J_")"
K ^TMP("SDEC",$J)
S ^TMP("SDEC",$J,0)="I00020RESOURCEID^T00030ERRORTEXT"_$C(30)
; Changed following from a $G = "" to $D check: $G didn't work since SDECVAL is an array. MJL 10/18/2006
I SDECVAL="",$D(SDECVAL)<2 D ERR(0,"SDEC16: Invalid null input Parameter") Q
;Unpack array at @XWBARY
I SDECVAL="" D
. N SDECC S SDECC=0 F S SDECC=$O(SDECVAL(SDECC)) Q:'SDECC D
. . S SDECVAL=SDECVAL_SDECVAL(SDECC)
;validate ien
S SDECIEN=$P(SDECVAL,"|")
I SDECIEN'="" I '$D(^SDEC(409.831,+SDECIEN,0)) D ERR(0,"SDEC16: Invalid IEN "_SDECIEN) Q
I +SDECIEN D
. S SDEC="EDIT"
. S SDECIENS=+SDECIEN_","
E D
. S SDEC="ADD"
. S SDECIENS="+1,"
;validate name
S SDECNAM=$P(SDECVAL,"|",2)
I SDEC="ADD",SDECNAM="" D ERR(0,"SDEC16: Resource Name is required.")
;Prevent adding entry with duplicate name
I $D(^SDEC(409.831,"B",SDECNAM)),$O(^SDEC(409.831,"B",SDECNAM,0))'=SDECIEN D Q
. D ERR(0,"SDEC16: Cannot have two Resources with the same name.")
. Q
;validate resource type (required)
S SDREST=$P(SDECVAL,"|",15)
S SDREST=$S(SDREST="H":"SC(",SDREST="P":"VA(200,",SDREST="A":"SDEC(409.834,",1:"")
I SDEC="ADD",SDREST="" D ERR(0,"SDEC16: Invalid resource type "_$P(SDECVAL,"|",15)) Q
;validate resource type ID (required)
S SDRESTID=$P(SDECVAL,"|",16)
I SDEC="ADD" I '$D(@("^"_SDREST_+SDRESTID_",0)")) D ERR(0,"SDEC16: Invalid resource type ID "_$P(SDECVAL,"|",16)) Q
;validate date/time entered
S SDEDT=$P(SDECVAL,"|",9),Y=""
I SDEDT'="" S %DT="TX" S X=$G(SDEDT) D ^%DT S SDEDT=Y
I Y=-1 D ERR(0,"SDEC16: Invalid date/time entered "_$P(SDECVAL,"|",9)) Q
;validate entered by user
S SDEUSR=$P(SDECVAL,"|",10)
I SDEUSR'="" I '$D(^VA(200,+SDEUSR,0)) D ERR(0,"SDEC16: Invalid entered by user id "_$P(SDECVAL,"|",10)) Q
;validate inactivation date
S SDIDT=$P(SDECVAL,"|",11),Y=""
I SDIDT'="" S %DT="TX" S X=$G(SDIDT) D ^%DT S SDIDT=Y
I Y=-1 D ERR(0,"SDEC16: Invalid inactivation date "_$P(SDECVAL,"|",11)) Q
;validate inactivation user
S SDIUSR=$P(SDECVAL,"|",12)
I SDIUSR'="" I '$D(^VA(200,+SDIUSR,0)) D ERR(0,"SDEC16: Invalid inactivation user id "_$P(SDECVAL,"|",12)) Q
;validate reactivation date
S SDRDT=$P(SDECVAL,"|",13),Y=""
I SDRDT'="" S %DT="TX" S X=$G(SDRDT) D ^%DT S SDRDT=Y
I Y=-1 D ERR(0,"SDEC16: Invalid reactivation date "_$P(SDECVAL,"|",13)) Q
;validate reactivation user
S SDRUSR=$P(SDECVAL,"|",14)
I SDRUSR'="" I '$D(^VA(200,+SDRUSR,0)) D ERR(0,"SDEC16: Invalid reactivation user id "_$P(SDECVAL,"|",14)) Q
;
S:$P(SDECVAL,"|",2)'="" SDECFDA(409.831,SDECIENS,.01)=$P(SDECVAL,"|",2) ;NAME
I SDRESTID'="",SDREST'="" S SDECFDA(409.831,SDECIENS,.012)=SDRESTID_";"_SDREST ;resource type
I SDEDT'="" S SDECFDA(409.831,SDECIENS,.015)=SDEDT
I SDEUSR'="" S SDECFDA(409.831,SDECIENS,.016)=SDEUSR
I SDIDT'="" S SDECFDA(409.831,SDECIENS,.021)=SDIDT S SDECFDA(409.831,SDECIENS,.025)=""
I SDIUSR'="" S SDECFDA(409.831,SDECIENS,.022)=SDIUSR S SDECFDA(409.831,SDECIENS,.026)=""
I SDRDT'="" S SDECFDA(409.831,SDECIENS,.025)=SDRDT
I SDRUSR'="" S SDECFDA(409.831,SDECIENS,.026)=SDRUSR
I +$P(SDECVAL,"|",5) S SDECFDA(409.831,SDECIENS,.03)=+$P(SDECVAL,"|",5) ;TIME SCALE
I +$P(SDECVAL,"|",4) S SDECFDA(409.831,SDECIENS,.04)=$P(SDECVAL,"|",4) ;HOSPITAL LOCATION
;
K SDECMSG
I SDEC="ADD" D ;TODO: Check for error
. K SDECIEN
. D UPDATE^DIE("","SDECFDA","SDECIEN","SDECMSG")
. S SDECIEN=+$G(SDECIEN(1))
E D
. D FILE^DIE("","SDECFDA","SDECMSG")
;
I $P(SDECVAL,"|",2)="@" D RSRCDEL(SDECIEN) G RSRCX
;LETTER TEXT wp field
S SDECNOTE=$P(SDECVAL,"|",6)
;
I SDECNOTE]"" S SDECNOTE(.5)=SDECNOTE,SDECNOTE=""
I $D(SDECNOTE(0)) S SDECNOTE(.5)=SDECNOTE(0) K SDECNOTE(0)
;
I $D(SDECNOTE(.5)) D
. D WP^DIE(409.831,SDECIEN_",",1,"","SDECNOTE","SDECMSG")
;
;NO SHOW LETTER wp fields
K SDECNOTE
S SDECNOTE=$P(SDECVAL,"|",7)
;
I SDECNOTE]"" S SDECNOTE(.5)=SDECNOTE,SDECNOTE=""
I $D(SDECNOTE(0)) S SDECNOTE(.5)=SDECNOTE(0) K SDECNOTE(0)
;
I $D(SDECNOTE(.5)) D
. D WP^DIE(409.831,SDECIEN_",",1201,"","SDECNOTE","SDECMSG")
;
;CANCELLATION LETTER wp field
K SDECNOTE
S SDECNOTE=$P(SDECVAL,"|",8)
;
I SDECNOTE]"" S SDECNOTE(.5)=SDECNOTE,SDECNOTE=""
I $D(SDECNOTE(0)) S SDECNOTE(.5)=SDECNOTE(0) K SDECNOTE(0)
;
I $D(SDECNOTE(.5)) D
. D WP^DIE(409.831,SDECIEN_",",1301,"","SDECNOTE","SDECMSG")
I $$GET1^DIQ(409.831,SDECIEN_",",.02)="YES" ;computed code calls RESDG^SDEC01B
RSRCX ;
S ^TMP("SDEC",$J,1)=$G(SDECIEN)_"^"_$C(30)_$C(31)
Q
;
RSRCDEL(SDECIEN) ;delete resource from supporting files
N SDECG,SDECH,SDECS,DA,DIE,DR
;remove SDEC RESOURCE from SDEC RESOURCE GROUP(s)
S SDECG=""
F S SDECG=$O(^SDEC(409.832,"AB",SDECIEN,SDECG)) Q:SDECG="" D
. S SDECS=""
. F S SDECS=$O(^SDEC(409.832,"AB",SDECIEN,SDECG,SDECS)) Q:SDECS="" D
. . S DIE="^SDEC(409.832,"_SDECG_",1,"
. . S DA=SDECS
. . S DA(1)=SDECG
. . S DR=".01///@"
. . D ^DIE
;
;remove SDEC RESOURCE from SDEC RESOURCE USER(s)
S SDECG=$O(^SDEC(409.833,"B",SDECIEN,"")) D
.I SDECG'="" D
..S DIE=409.833
..S DA=SDECG
..S DR=".01///@"
..D ^DIE
;
;remove appointments that are linked to SDEC RESOURCE in the SDEC APPOINTMENT file
S SDECG=""
F S SDECG=$O(^SDEC(409.84,"ARSRC",SDECIEN,SDECG)) Q:SDECG="" D
. S SDECH=""
. S SDECH=$O(^SDEC(409.84,"ARSRC",SDECIEN,SDECG,SDECH)) Q:SDECH="" D
. . S DIE=409.84
. . S DA=SDECH
. . S DR=".01///@"
. . D ^DIE
;
Q
;
ERROR ;
D ^%ZTER
I '+$G(SDECI) N SDECI S SDECI=999999
S SDECI=SDECI+1
D ERR(0,"SDEC16 Error")
Q
;
ERR(SDECERID,ERRTXT) ;Error processing
S:'+$G(SDECI) SDECI=999999
S SDECI=SDECI+1
S ^TMP("SDEC",$J,SDECI)=SDECERID_"^"_ERRTXT_$C(30)
S SDECI=SDECI+1
S ^TMP("SDEC",$J,SDECI)=$C(31)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDEC16 8924 printed Dec 13, 2024@02:50:09 Page 2
SDEC16 ;ALB/SAT - VISTA SCHEDULING RPCS ;JAN 15, 2016
+1 ;;5.3;Scheduling;**627**;Aug 13, 1993;Build 249
+2 ;
+3 QUIT
+4 ;
ADDRES(SDECY,SDECVAL) ;ADD/EDIT RESOURCE
+1 ;ADDRES(SDECY,SDECVAL) external parameter tag is in SDEC
+2 ;Add/Edit SDEC RESOURCE entry
+3 ;INPUT:
+4 ; SDECVAL - ResourceID|ResourceName|<NOT USED>|HospLocID|TIME_SCALE
+5 ; |LETTER_TEXT|NO_SHOW_LETTER|CANCELLATION_LETTER
+6 ; | INACTIVATEDDT | INACTIVATEDUSR | REACTIVATEDDT
+7 ; | REACTIVATEDUSR | RESOURCETYPE | RESOURCETYPEIEN
+8 ; 1. ResourceID - (optional) Pointer to the SDEC RESOURCE file
+9 ; a new entry is added if IEN is 0
+10 ; 2. ResourceName - (required) Value put into the RESOURCE field
+11 ; of the SDEC RESOURCE file
+12 ; 3. NOT USED INACTIVE This is 'computed' based on inactivation
+13 ; and reactivation fields
+14 ; 4. HospLocID - (required) Hospital Location ID - pointer to the
+15 ; HOSPITAL LOCATION file 44
+16 ; 5. TIME_SCALE - (optional) Value put into the TIME SCALE field
+17 ; of the SDEC RESOURCE file
+18 ; Allowed values: 5 10 15 20 30 60
+19 ; 6. LETTER_TEXT - (optional) Value converted to Word Processor and
+20 ; put into the LETTER TEXT field of the
+21 ; SDEC RESOURCE file
+22 ; 7. NO_SHOW_LETTER - (optional) Value converted to Word Processor
+23 ; and put into the NO SHOW LETTER field of
+24 ; the SDEC RESOURCE file
+25 ; 8. CANCELLATION_LETTER - (optional) Value converted to
+26 ; Word Processor and put into the CLINIC
+27 ; CANCELLATION LETTER field
+28 ; of the SDEC RESOURCE file
+29 ; 9. DATE/TIME - (optional) DATE/TIME entered in external format
+30 ; Defaults to NOW.
+31 ; 10. ENTEREDBY - (optional) Entered by User pointer to NEW PERSON
+32 ; Defaults to current user
+33 ; 11. INACTIVATEDDT - (optional) inactivated Date/Time external format
+34 ; 12. INACTIVATEDUSR- (optional) inactivating user pointer to
+35 ; NEW PERSON file
+36 ; 13. REACTIVATEDDT - (optional) reactivated Date/Time external format
+37 ; 14. REACTIVATEDUSR- (optional) reactivating user pointer to
+38 ; NEW PERSON file
+39 ; 15. RESOURCETYPE - (required) valid values are:
+40 ; H for HOSPITAL LOCATION (or clinic)
+41 ; P for NEW PERSON (Provider)
+42 ; A for ADDITIONAL RESOURCE
+43 ; 16. RESOURCETYPEIEN - (required) pointer to 1 of the following:
+44 ; HOSPITAL LOCATION file
+45 ; NEW PERSON file
+46 ; ADDITIONAL RESOURCE file
+47 ;RETURN:
+48 ; SDEC RESOURCE ien
+49 ;
+50 ;
+51 NEW SDECIENS,SDECFDA,SDECIEN,SDECMSG,SDEC,SDECINA,SDECNOTE,SDECNAM
+52 NEW SDEDT,SDEUSR,SDIDT,SDIUSR,SDRDT,SDRUSR,SDREST,SDRESTID
+53 NEW %DT,X,Y
+54 SET SDECY="^TMP(""SDEC"","_$JOB_")"
+55 KILL ^TMP("SDEC",$JOB)
+56 SET ^TMP("SDEC",$JOB,0)="I00020RESOURCEID^T00030ERRORTEXT"_$CHAR(30)
+57 ; Changed following from a $G = "" to $D check: $G didn't work since SDECVAL is an array. MJL 10/18/2006
+58 IF SDECVAL=""
IF $DATA(SDECVAL)<2
DO ERR(0,"SDEC16: Invalid null input Parameter")
QUIT
+59 ;Unpack array at @XWBARY
+60 IF SDECVAL=""
Begin DoDot:1
+61 NEW SDECC
SET SDECC=0
FOR
SET SDECC=$ORDER(SDECVAL(SDECC))
if 'SDECC
QUIT
Begin DoDot:2
+62 SET SDECVAL=SDECVAL_SDECVAL(SDECC)
End DoDot:2
End DoDot:1
+63 ;validate ien
+64 SET SDECIEN=$PIECE(SDECVAL,"|")
+65 IF SDECIEN'=""
IF '$DATA(^SDEC(409.831,+SDECIEN,0))
DO ERR(0,"SDEC16: Invalid IEN "_SDECIEN)
QUIT
+66 IF +SDECIEN
Begin DoDot:1
+67 SET SDEC="EDIT"
+68 SET SDECIENS=+SDECIEN_","
End DoDot:1
+69 IF '$TEST
Begin DoDot:1
+70 SET SDEC="ADD"
+71 SET SDECIENS="+1,"
End DoDot:1
+72 ;validate name
+73 SET SDECNAM=$PIECE(SDECVAL,"|",2)
+74 IF SDEC="ADD"
IF SDECNAM=""
DO ERR(0,"SDEC16: Resource Name is required.")
+75 ;Prevent adding entry with duplicate name
+76 IF $DATA(^SDEC(409.831,"B",SDECNAM))
IF $ORDER(^SDEC(409.831,"B",SDECNAM,0))'=SDECIEN
Begin DoDot:1
+77 DO ERR(0,"SDEC16: Cannot have two Resources with the same name.")
+78 QUIT
End DoDot:1
QUIT
+79 ;validate resource type (required)
+80 SET SDREST=$PIECE(SDECVAL,"|",15)
+81 SET SDREST=$SELECT(SDREST="H":"SC(",SDREST="P":"VA(200,",SDREST="A":"SDEC(409.834,",1:"")
+82 IF SDEC="ADD"
IF SDREST=""
DO ERR(0,"SDEC16: Invalid resource type "_$PIECE(SDECVAL,"|",15))
QUIT
+83 ;validate resource type ID (required)
+84 SET SDRESTID=$PIECE(SDECVAL,"|",16)
+85 IF SDEC="ADD"
IF '$DATA(@("^"_SDREST_+SDRESTID_",0)"))
DO ERR(0,"SDEC16: Invalid resource type ID "_$PIECE(SDECVAL,"|",16))
QUIT
+86 ;validate date/time entered
+87 SET SDEDT=$PIECE(SDECVAL,"|",9)
SET Y=""
+88 IF SDEDT'=""
SET %DT="TX"
SET X=$GET(SDEDT)
DO ^%DT
SET SDEDT=Y
+89 IF Y=-1
DO ERR(0,"SDEC16: Invalid date/time entered "_$PIECE(SDECVAL,"|",9))
QUIT
+90 ;validate entered by user
+91 SET SDEUSR=$PIECE(SDECVAL,"|",10)
+92 IF SDEUSR'=""
IF '$DATA(^VA(200,+SDEUSR,0))
DO ERR(0,"SDEC16: Invalid entered by user id "_$PIECE(SDECVAL,"|",10))
QUIT
+93 ;validate inactivation date
+94 SET SDIDT=$PIECE(SDECVAL,"|",11)
SET Y=""
+95 IF SDIDT'=""
SET %DT="TX"
SET X=$GET(SDIDT)
DO ^%DT
SET SDIDT=Y
+96 IF Y=-1
DO ERR(0,"SDEC16: Invalid inactivation date "_$PIECE(SDECVAL,"|",11))
QUIT
+97 ;validate inactivation user
+98 SET SDIUSR=$PIECE(SDECVAL,"|",12)
+99 IF SDIUSR'=""
IF '$DATA(^VA(200,+SDIUSR,0))
DO ERR(0,"SDEC16: Invalid inactivation user id "_$PIECE(SDECVAL,"|",12))
QUIT
+100 ;validate reactivation date
+101 SET SDRDT=$PIECE(SDECVAL,"|",13)
SET Y=""
+102 IF SDRDT'=""
SET %DT="TX"
SET X=$GET(SDRDT)
DO ^%DT
SET SDRDT=Y
+103 IF Y=-1
DO ERR(0,"SDEC16: Invalid reactivation date "_$PIECE(SDECVAL,"|",13))
QUIT
+104 ;validate reactivation user
+105 SET SDRUSR=$PIECE(SDECVAL,"|",14)
+106 IF SDRUSR'=""
IF '$DATA(^VA(200,+SDRUSR,0))
DO ERR(0,"SDEC16: Invalid reactivation user id "_$PIECE(SDECVAL,"|",14))
QUIT
+107 ;
+108 ;NAME
if $PIECE(SDECVAL,"|",2)'=""
SET SDECFDA(409.831,SDECIENS,.01)=$PIECE(SDECVAL,"|",2)
+109 ;resource type
IF SDRESTID'=""
IF SDREST'=""
SET SDECFDA(409.831,SDECIENS,.012)=SDRESTID_";"_SDREST
+110 IF SDEDT'=""
SET SDECFDA(409.831,SDECIENS,.015)=SDEDT
+111 IF SDEUSR'=""
SET SDECFDA(409.831,SDECIENS,.016)=SDEUSR
+112 IF SDIDT'=""
SET SDECFDA(409.831,SDECIENS,.021)=SDIDT
SET SDECFDA(409.831,SDECIENS,.025)=""
+113 IF SDIUSR'=""
SET SDECFDA(409.831,SDECIENS,.022)=SDIUSR
SET SDECFDA(409.831,SDECIENS,.026)=""
+114 IF SDRDT'=""
SET SDECFDA(409.831,SDECIENS,.025)=SDRDT
+115 IF SDRUSR'=""
SET SDECFDA(409.831,SDECIENS,.026)=SDRUSR
+116 ;TIME SCALE
IF +$PIECE(SDECVAL,"|",5)
SET SDECFDA(409.831,SDECIENS,.03)=+$PIECE(SDECVAL,"|",5)
+117 ;HOSPITAL LOCATION
IF +$PIECE(SDECVAL,"|",4)
SET SDECFDA(409.831,SDECIENS,.04)=$PIECE(SDECVAL,"|",4)
+118 ;
+119 KILL SDECMSG
+120 ;TODO: Check for error
IF SDEC="ADD"
Begin DoDot:1
+121 KILL SDECIEN
+122 DO UPDATE^DIE("","SDECFDA","SDECIEN","SDECMSG")
+123 SET SDECIEN=+$GET(SDECIEN(1))
End DoDot:1
+124 IF '$TEST
Begin DoDot:1
+125 DO FILE^DIE("","SDECFDA","SDECMSG")
End DoDot:1
+126 ;
+127 IF $PIECE(SDECVAL,"|",2)="@"
DO RSRCDEL(SDECIEN)
GOTO RSRCX
+128 ;LETTER TEXT wp field
+129 SET SDECNOTE=$PIECE(SDECVAL,"|",6)
+130 ;
+131 IF SDECNOTE]""
SET SDECNOTE(.5)=SDECNOTE
SET SDECNOTE=""
+132 IF $DATA(SDECNOTE(0))
SET SDECNOTE(.5)=SDECNOTE(0)
KILL SDECNOTE(0)
+133 ;
+134 IF $DATA(SDECNOTE(.5))
Begin DoDot:1
+135 DO WP^DIE(409.831,SDECIEN_",",1,"","SDECNOTE","SDECMSG")
End DoDot:1
+136 ;
+137 ;NO SHOW LETTER wp fields
+138 KILL SDECNOTE
+139 SET SDECNOTE=$PIECE(SDECVAL,"|",7)
+140 ;
+141 IF SDECNOTE]""
SET SDECNOTE(.5)=SDECNOTE
SET SDECNOTE=""
+142 IF $DATA(SDECNOTE(0))
SET SDECNOTE(.5)=SDECNOTE(0)
KILL SDECNOTE(0)
+143 ;
+144 IF $DATA(SDECNOTE(.5))
Begin DoDot:1
+145 DO WP^DIE(409.831,SDECIEN_",",1201,"","SDECNOTE","SDECMSG")
End DoDot:1
+146 ;
+147 ;CANCELLATION LETTER wp field
+148 KILL SDECNOTE
+149 SET SDECNOTE=$PIECE(SDECVAL,"|",8)
+150 ;
+151 IF SDECNOTE]""
SET SDECNOTE(.5)=SDECNOTE
SET SDECNOTE=""
+152 IF $DATA(SDECNOTE(0))
SET SDECNOTE(.5)=SDECNOTE(0)
KILL SDECNOTE(0)
+153 ;
+154 IF $DATA(SDECNOTE(.5))
Begin DoDot:1
+155 DO WP^DIE(409.831,SDECIEN_",",1301,"","SDECNOTE","SDECMSG")
End DoDot:1
+156 ;computed code calls RESDG^SDEC01B
IF $$GET1^DIQ(409.831,SDECIEN_",",.02)="YES"
RSRCX ;
+1 SET ^TMP("SDEC",$JOB,1)=$GET(SDECIEN)_"^"_$CHAR(30)_$CHAR(31)
+2 QUIT
+3 ;
RSRCDEL(SDECIEN) ;delete resource from supporting files
+1 NEW SDECG,SDECH,SDECS,DA,DIE,DR
+2 ;remove SDEC RESOURCE from SDEC RESOURCE GROUP(s)
+3 SET SDECG=""
+4 FOR
SET SDECG=$ORDER(^SDEC(409.832,"AB",SDECIEN,SDECG))
if SDECG=""
QUIT
Begin DoDot:1
+5 SET SDECS=""
+6 FOR
SET SDECS=$ORDER(^SDEC(409.832,"AB",SDECIEN,SDECG,SDECS))
if SDECS=""
QUIT
Begin DoDot:2
+7 SET DIE="^SDEC(409.832,"_SDECG_",1,"
+8 SET DA=SDECS
+9 SET DA(1)=SDECG
+10 SET DR=".01///@"
+11 DO ^DIE
End DoDot:2
End DoDot:1
+12 ;
+13 ;remove SDEC RESOURCE from SDEC RESOURCE USER(s)
+14 SET SDECG=$ORDER(^SDEC(409.833,"B",SDECIEN,""))
Begin DoDot:1
+15 IF SDECG'=""
Begin DoDot:2
+16 SET DIE=409.833
+17 SET DA=SDECG
+18 SET DR=".01///@"
+19 DO ^DIE
End DoDot:2
End DoDot:1
+20 ;
+21 ;remove appointments that are linked to SDEC RESOURCE in the SDEC APPOINTMENT file
+22 SET SDECG=""
+23 FOR
SET SDECG=$ORDER(^SDEC(409.84,"ARSRC",SDECIEN,SDECG))
if SDECG=""
QUIT
Begin DoDot:1
+24 SET SDECH=""
+25 SET SDECH=$ORDER(^SDEC(409.84,"ARSRC",SDECIEN,SDECG,SDECH))
if SDECH=""
QUIT
Begin DoDot:2
+26 SET DIE=409.84
+27 SET DA=SDECH
+28 SET DR=".01///@"
+29 DO ^DIE
End DoDot:2
End DoDot:1
+30 ;
+31 QUIT
+32 ;
ERROR ;
+1 DO ^%ZTER
+2 IF '+$GET(SDECI)
NEW SDECI
SET SDECI=999999
+3 SET SDECI=SDECI+1
+4 DO ERR(0,"SDEC16 Error")
+5 QUIT
+6 ;
ERR(SDECERID,ERRTXT) ;Error processing
+1 if '+$GET(SDECI)
SET SDECI=999999
+2 SET SDECI=SDECI+1
+3 SET ^TMP("SDEC",$JOB,SDECI)=SDECERID_"^"_ERRTXT_$CHAR(30)
+4 SET SDECI=SDECI+1
+5 SET ^TMP("SDEC",$JOB,SDECI)=$CHAR(31)
+6 QUIT
