- 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 Feb 19, 2025@00:16:36 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