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

SDEC16.m

Go to the documentation of this file.
  1. SDEC16 ;ALB/SAT - VISTA SCHEDULING RPCS ;JAN 15, 2016
  1. ;;5.3;Scheduling;**627**;Aug 13, 1993;Build 249
  1. ;
  1. Q
  1. ;
  1. ADDRES(SDECY,SDECVAL) ;ADD/EDIT RESOURCE
  1. ;ADDRES(SDECY,SDECVAL) external parameter tag is in SDEC
  1. ;Add/Edit SDEC RESOURCE entry
  1. ;INPUT:
  1. ; SDECVAL - ResourceID|ResourceName|<NOT USED>|HospLocID|TIME_SCALE
  1. ; |LETTER_TEXT|NO_SHOW_LETTER|CANCELLATION_LETTER
  1. ; | INACTIVATEDDT | INACTIVATEDUSR | REACTIVATEDDT
  1. ; | REACTIVATEDUSR | RESOURCETYPE | RESOURCETYPEIEN
  1. ; 1. ResourceID - (optional) Pointer to the SDEC RESOURCE file
  1. ; a new entry is added if IEN is 0
  1. ; 2. ResourceName - (required) Value put into the RESOURCE field
  1. ; of the SDEC RESOURCE file
  1. ; 3. NOT USED INACTIVE This is 'computed' based on inactivation
  1. ; and reactivation fields
  1. ; 4. HospLocID - (required) Hospital Location ID - pointer to the
  1. ; HOSPITAL LOCATION file 44
  1. ; 5. TIME_SCALE - (optional) Value put into the TIME SCALE field
  1. ; of the SDEC RESOURCE file
  1. ; Allowed values: 5 10 15 20 30 60
  1. ; 6. LETTER_TEXT - (optional) Value converted to Word Processor and
  1. ; put into the LETTER TEXT field of the
  1. ; SDEC RESOURCE file
  1. ; 7. NO_SHOW_LETTER - (optional) Value converted to Word Processor
  1. ; and put into the NO SHOW LETTER field of
  1. ; the SDEC RESOURCE file
  1. ; 8. CANCELLATION_LETTER - (optional) Value converted to
  1. ; Word Processor and put into the CLINIC
  1. ; CANCELLATION LETTER field
  1. ; of the SDEC RESOURCE file
  1. ; 9. DATE/TIME - (optional) DATE/TIME entered in external format
  1. ; Defaults to NOW.
  1. ; 10. ENTEREDBY - (optional) Entered by User pointer to NEW PERSON
  1. ; Defaults to current user
  1. ; 11. INACTIVATEDDT - (optional) inactivated Date/Time external format
  1. ; 12. INACTIVATEDUSR- (optional) inactivating user pointer to
  1. ; NEW PERSON file
  1. ; 13. REACTIVATEDDT - (optional) reactivated Date/Time external format
  1. ; 14. REACTIVATEDUSR- (optional) reactivating user pointer to
  1. ; NEW PERSON file
  1. ; 15. RESOURCETYPE - (required) valid values are:
  1. ; H for HOSPITAL LOCATION (or clinic)
  1. ; P for NEW PERSON (Provider)
  1. ; A for ADDITIONAL RESOURCE
  1. ; 16. RESOURCETYPEIEN - (required) pointer to 1 of the following:
  1. ; HOSPITAL LOCATION file
  1. ; NEW PERSON file
  1. ; ADDITIONAL RESOURCE file
  1. ;RETURN:
  1. ; SDEC RESOURCE ien
  1. ;
  1. ;
  1. N SDECIENS,SDECFDA,SDECIEN,SDECMSG,SDEC,SDECINA,SDECNOTE,SDECNAM
  1. N SDEDT,SDEUSR,SDIDT,SDIUSR,SDRDT,SDRUSR,SDREST,SDRESTID
  1. N %DT,X,Y
  1. S SDECY="^TMP(""SDEC"","_$J_")"
  1. K ^TMP("SDEC",$J)
  1. S ^TMP("SDEC",$J,0)="I00020RESOURCEID^T00030ERRORTEXT"_$C(30)
  1. ; Changed following from a $G = "" to $D check: $G didn't work since SDECVAL is an array. MJL 10/18/2006
  1. I SDECVAL="",$D(SDECVAL)<2 D ERR(0,"SDEC16: Invalid null input Parameter") Q
  1. ;Unpack array at @XWBARY
  1. I SDECVAL="" D
  1. . N SDECC S SDECC=0 F S SDECC=$O(SDECVAL(SDECC)) Q:'SDECC D
  1. . . S SDECVAL=SDECVAL_SDECVAL(SDECC)
  1. ;validate ien
  1. S SDECIEN=$P(SDECVAL,"|")
  1. I SDECIEN'="" I '$D(^SDEC(409.831,+SDECIEN,0)) D ERR(0,"SDEC16: Invalid IEN "_SDECIEN) Q
  1. I +SDECIEN D
  1. . S SDEC="EDIT"
  1. . S SDECIENS=+SDECIEN_","
  1. E D
  1. . S SDEC="ADD"
  1. . S SDECIENS="+1,"
  1. ;validate name
  1. S SDECNAM=$P(SDECVAL,"|",2)
  1. I SDEC="ADD",SDECNAM="" D ERR(0,"SDEC16: Resource Name is required.")
  1. ;Prevent adding entry with duplicate name
  1. I $D(^SDEC(409.831,"B",SDECNAM)),$O(^SDEC(409.831,"B",SDECNAM,0))'=SDECIEN D Q
  1. . D ERR(0,"SDEC16: Cannot have two Resources with the same name.")
  1. . Q
  1. ;validate resource type (required)
  1. S SDREST=$P(SDECVAL,"|",15)
  1. S SDREST=$S(SDREST="H":"SC(",SDREST="P":"VA(200,",SDREST="A":"SDEC(409.834,",1:"")
  1. I SDEC="ADD",SDREST="" D ERR(0,"SDEC16: Invalid resource type "_$P(SDECVAL,"|",15)) Q
  1. ;validate resource type ID (required)
  1. S SDRESTID=$P(SDECVAL,"|",16)
  1. I SDEC="ADD" I '$D(@("^"_SDREST_+SDRESTID_",0)")) D ERR(0,"SDEC16: Invalid resource type ID "_$P(SDECVAL,"|",16)) Q
  1. ;validate date/time entered
  1. S SDEDT=$P(SDECVAL,"|",9),Y=""
  1. I SDEDT'="" S %DT="TX" S X=$G(SDEDT) D ^%DT S SDEDT=Y
  1. I Y=-1 D ERR(0,"SDEC16: Invalid date/time entered "_$P(SDECVAL,"|",9)) Q
  1. ;validate entered by user
  1. S SDEUSR=$P(SDECVAL,"|",10)
  1. I SDEUSR'="" I '$D(^VA(200,+SDEUSR,0)) D ERR(0,"SDEC16: Invalid entered by user id "_$P(SDECVAL,"|",10)) Q
  1. ;validate inactivation date
  1. S SDIDT=$P(SDECVAL,"|",11),Y=""
  1. I SDIDT'="" S %DT="TX" S X=$G(SDIDT) D ^%DT S SDIDT=Y
  1. I Y=-1 D ERR(0,"SDEC16: Invalid inactivation date "_$P(SDECVAL,"|",11)) Q
  1. ;validate inactivation user
  1. S SDIUSR=$P(SDECVAL,"|",12)
  1. I SDIUSR'="" I '$D(^VA(200,+SDIUSR,0)) D ERR(0,"SDEC16: Invalid inactivation user id "_$P(SDECVAL,"|",12)) Q
  1. ;validate reactivation date
  1. S SDRDT=$P(SDECVAL,"|",13),Y=""
  1. I SDRDT'="" S %DT="TX" S X=$G(SDRDT) D ^%DT S SDRDT=Y
  1. I Y=-1 D ERR(0,"SDEC16: Invalid reactivation date "_$P(SDECVAL,"|",13)) Q
  1. ;validate reactivation user
  1. S SDRUSR=$P(SDECVAL,"|",14)
  1. I SDRUSR'="" I '$D(^VA(200,+SDRUSR,0)) D ERR(0,"SDEC16: Invalid reactivation user id "_$P(SDECVAL,"|",14)) Q
  1. ;
  1. S:$P(SDECVAL,"|",2)'="" SDECFDA(409.831,SDECIENS,.01)=$P(SDECVAL,"|",2) ;NAME
  1. I SDRESTID'="",SDREST'="" S SDECFDA(409.831,SDECIENS,.012)=SDRESTID_";"_SDREST ;resource type
  1. I SDEDT'="" S SDECFDA(409.831,SDECIENS,.015)=SDEDT
  1. I SDEUSR'="" S SDECFDA(409.831,SDECIENS,.016)=SDEUSR
  1. I SDIDT'="" S SDECFDA(409.831,SDECIENS,.021)=SDIDT S SDECFDA(409.831,SDECIENS,.025)=""
  1. I SDIUSR'="" S SDECFDA(409.831,SDECIENS,.022)=SDIUSR S SDECFDA(409.831,SDECIENS,.026)=""
  1. I SDRDT'="" S SDECFDA(409.831,SDECIENS,.025)=SDRDT
  1. I SDRUSR'="" S SDECFDA(409.831,SDECIENS,.026)=SDRUSR
  1. I +$P(SDECVAL,"|",5) S SDECFDA(409.831,SDECIENS,.03)=+$P(SDECVAL,"|",5) ;TIME SCALE
  1. I +$P(SDECVAL,"|",4) S SDECFDA(409.831,SDECIENS,.04)=$P(SDECVAL,"|",4) ;HOSPITAL LOCATION
  1. ;
  1. K SDECMSG
  1. I SDEC="ADD" D ;TODO: Check for error
  1. . K SDECIEN
  1. . D UPDATE^DIE("","SDECFDA","SDECIEN","SDECMSG")
  1. . S SDECIEN=+$G(SDECIEN(1))
  1. E D
  1. . D FILE^DIE("","SDECFDA","SDECMSG")
  1. ;
  1. I $P(SDECVAL,"|",2)="@" D RSRCDEL(SDECIEN) G RSRCX
  1. ;LETTER TEXT wp field
  1. S SDECNOTE=$P(SDECVAL,"|",6)
  1. ;
  1. I SDECNOTE]"" S SDECNOTE(.5)=SDECNOTE,SDECNOTE=""
  1. I $D(SDECNOTE(0)) S SDECNOTE(.5)=SDECNOTE(0) K SDECNOTE(0)
  1. ;
  1. I $D(SDECNOTE(.5)) D
  1. . D WP^DIE(409.831,SDECIEN_",",1,"","SDECNOTE","SDECMSG")
  1. ;
  1. ;NO SHOW LETTER wp fields
  1. K SDECNOTE
  1. S SDECNOTE=$P(SDECVAL,"|",7)
  1. ;
  1. I SDECNOTE]"" S SDECNOTE(.5)=SDECNOTE,SDECNOTE=""
  1. I $D(SDECNOTE(0)) S SDECNOTE(.5)=SDECNOTE(0) K SDECNOTE(0)
  1. ;
  1. I $D(SDECNOTE(.5)) D
  1. . D WP^DIE(409.831,SDECIEN_",",1201,"","SDECNOTE","SDECMSG")
  1. ;
  1. ;CANCELLATION LETTER wp field
  1. K SDECNOTE
  1. S SDECNOTE=$P(SDECVAL,"|",8)
  1. ;
  1. I SDECNOTE]"" S SDECNOTE(.5)=SDECNOTE,SDECNOTE=""
  1. I $D(SDECNOTE(0)) S SDECNOTE(.5)=SDECNOTE(0) K SDECNOTE(0)
  1. ;
  1. I $D(SDECNOTE(.5)) D
  1. . D WP^DIE(409.831,SDECIEN_",",1301,"","SDECNOTE","SDECMSG")
  1. I $$GET1^DIQ(409.831,SDECIEN_",",.02)="YES" ;computed code calls RESDG^SDEC01B
  1. RSRCX ;
  1. S ^TMP("SDEC",$J,1)=$G(SDECIEN)_"^"_$C(30)_$C(31)
  1. Q
  1. ;
  1. RSRCDEL(SDECIEN) ;delete resource from supporting files
  1. N SDECG,SDECH,SDECS,DA,DIE,DR
  1. ;remove SDEC RESOURCE from SDEC RESOURCE GROUP(s)
  1. S SDECG=""
  1. F S SDECG=$O(^SDEC(409.832,"AB",SDECIEN,SDECG)) Q:SDECG="" D
  1. . S SDECS=""
  1. . F S SDECS=$O(^SDEC(409.832,"AB",SDECIEN,SDECG,SDECS)) Q:SDECS="" D
  1. . . S DIE="^SDEC(409.832,"_SDECG_",1,"
  1. . . S DA=SDECS
  1. . . S DA(1)=SDECG
  1. . . S DR=".01///@"
  1. . . D ^DIE
  1. ;
  1. ;remove SDEC RESOURCE from SDEC RESOURCE USER(s)
  1. S SDECG=$O(^SDEC(409.833,"B",SDECIEN,"")) D
  1. .I SDECG'="" D
  1. ..S DIE=409.833
  1. ..S DA=SDECG
  1. ..S DR=".01///@"
  1. ..D ^DIE
  1. ;
  1. ;remove appointments that are linked to SDEC RESOURCE in the SDEC APPOINTMENT file
  1. S SDECG=""
  1. F S SDECG=$O(^SDEC(409.84,"ARSRC",SDECIEN,SDECG)) Q:SDECG="" D
  1. . S SDECH=""
  1. . S SDECH=$O(^SDEC(409.84,"ARSRC",SDECIEN,SDECG,SDECH)) Q:SDECH="" D
  1. . . S DIE=409.84
  1. . . S DA=SDECH
  1. . . S DR=".01///@"
  1. . . D ^DIE
  1. ;
  1. Q
  1. ;
  1. ERROR ;
  1. D ^%ZTER
  1. I '+$G(SDECI) N SDECI S SDECI=999999
  1. S SDECI=SDECI+1
  1. D ERR(0,"SDEC16 Error")
  1. Q
  1. ;
  1. ERR(SDECERID,ERRTXT) ;Error processing
  1. S:'+$G(SDECI) SDECI=999999
  1. S SDECI=SDECI+1
  1. S ^TMP("SDEC",$J,SDECI)=SDECERID_"^"_ERRTXT_$C(30)
  1. S SDECI=SDECI+1
  1. S ^TMP("SDEC",$J,SDECI)=$C(31)
  1. Q