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

SDEC49.m

Go to the documentation of this file. 
  1. SDEC49 ;ALB/SAT,WTC,TJB - VISTA SCHEDULING RPCS ;OCT 24, 2024
  1.  ;;5.3;Scheduling;**627,658,694,895**;Aug 13, 1993;Build 11
  1.  ;
  1.  ;  ICR
  1.  ;  ---
  1.  ;  10060 - #200 new person
  1.  Q
  1.  ;
  1. PREFSET(SDECY,DFN,PREF,REMARK) ; Set values to SDEC PREFERENCES AND SPECIAL NEEDS file  ;alb/sat add REMARK
  1.  ;PREFSET(SDECY,DFN,PREF,REMARK)  external parameter tag is in SDEC
  1.  ;INPUT:
  1.  ;  DFN  = (integer) Patient ID - Pointer to the PATIENT file 2  (lookup by name is not accurate if duplicates)
  1.  ;  PREF = List of preference data separated by ^
  1.  ;         Each ^ piece contains the following Pipe pieces |:
  1.  ;          1. (required)       Preference text; precede text with @ to delete
  1.  ;                              use SDEC PREFGETV to get current valid values.
  1.  ;                              Valid values at this time are:
  1.  ;                                GENDER SPECIFIC PROVIDER
  1.  ;                                HEARING IMPAIRED
  1.  ;                                LANGUAGE PREFERENCE
  1.  ;                                NEEDS ESCORT
  1.  ;                                ON STRETCHER
  1.  ;                                SPECIAL MODE OF TRANSPORTATION
  1.  ;                                MORNING
  1.  ;                                AFTERNOON
  1.  ;                                MONDAY
  1.  ;                                TUESDAY
  1.  ;                                WEDNESDAY
  1.  ;                                THURSDAY
  1.  ;                                FRIDAY
  1.  ;          2. (optional)       Date/Time preference added in external format - defaults to NOW (new entry only)
  1.  ;          3. (optional)       Added by User - Pointer to NEW PERSON file - defaults to Current User (new entry only)
  1.  ;          4. (optional)       Date/Time Inactivated in external format  default to NOW if active flag set to inactive
  1.  ;          5. (optional)       Inactivated by user - Pointer to NEW PERSON file default to current user if active flag set to inactive
  1.  ;          6. (optional )      <not used>
  1.  ;          7. (optional)       active flag 0=inactive; 1=active; default to active
  1.  ;  REMARK = Remarks single string of text will be converted to word processor format.
  1.  ;                              @ deletes previous Remark
  1.  ;RETURN:
  1.  ; Successful Return:
  1.  ;   A single entry in the Global Array in the format "0^<optional msg text>"
  1.  ;   "T00020RETURNCODE^T00100TEXT"
  1.  ; Caught Exception Return:
  1.  ;   A single entry in the Global Array in the format "-1^<error text>"
  1.  ;   "T00020RETURNCODE^T00100TEXT"
  1.  ; Unexpected Exception Return:
  1.  ;     Handled by the RPC Broker.
  1.  ;     M errors are trapped by the use of M and Kernel error handling.
  1.  ;     The RPC execution stops and the RPC Broker sends the error generated
  1.  ;     text back to the client.
  1.  ;
  1.  N PIEN,PIEN1,SDFDA,SDI,SDECI,SDIEN,SDACT,SDINOD,SDINOD1,SDMSG,SDPREF,SDQUIT,SDREMARK,X,Y,%DT
  1.  S SDECI=0,SDACT=0
  1.  K ^TMP("SDEC",$J)
  1.  S SDECY="^TMP(""SDEC"","_$J_")"
  1.  ; data header
  1.  S @SDECY@(0)="T00020RETURNCODE^T00100TEXT"_$C(30)
  1.  ;validate REMARK  ;alb/sat 658
  1.  S REMARK=$TR($G(REMARK),"^"," ")
  1.  ;check for valid Patient
  1.  I '+DFN D ERR1^SDECERR(1,"Invalid Patient ID.",.SDECI,SDECY) Q
  1.  I '$D(^DPT(DFN,0)) D ERR1^SDECERR(1,"Invalid Patient ID.",.SDECI,SDECY) Q
  1.  ;check for existing patient entry
  1.  S PIEN=$O(^SDEC(409.845,"B",DFN,0))
  1.  ;add new patient entry
  1.  I 'PIEN D
  1.  .S SDFDA(409.845,"+1,",.01)=DFN
  1.  .D UPDATE^DIE("","SDFDA","SDIEN","SDMSG")
  1.  .S PIEN=$G(SDIEN(1))
  1.  I 'PIEN D ERR1^SDECERR(1,"Error adding patient "_DFN_" to SDEC PREFERENCES AND SPECIAL NEEDS file.",.SDECI,SDECY) Q
  1.  ;get list of valid preferences
  1.  D PREF(.SDPREF)   ;SDPREF(<TEXT>)=<CODE>
  1.  ;add preference data
  1.  F SDI=1:1:$L(PREF,"^") D
  1.  .S SDINOD=$P(PREF,"^",SDI)
  1.  .Q:SDINOD=""
  1.  .I $E($P(SDINOD,"|",1),1)="@" D  Q
  1.  ..I $D(SDPREF($P($P(SDINOD,"|",1),"@",2))) D  Q
  1.  ...;delete this preference if @
  1.  ...K SDFDA,SDMSG
  1.  ...S PIEN1=$O(^SDEC(409.845,PIEN,1,"B",SDPREF($P($P(SDINOD,"|",1),"@",2)),0))
  1.  ...Q:'PIEN1
  1.  ...S SDFDA=$NA(SDFDA(409.8451,PIEN1_","_PIEN_","))
  1.  ...S @SDFDA@(.01)="@"
  1.  ...D UPDATE^DIE("","SDFDA","","SDMSG")
  1.  .I '$D(SDPREF($P(SDINOD,"|",1))) Q
  1.  .S PIEN1=$O(^SDEC(409.845,PIEN,1,"B",SDPREF($P(SDINOD,"|",1)),0))
  1.  .;quit if no changes to this preference
  1.  .S SDQUIT=0
  1.  .Q:+SDQUIT
  1.  .;edit preference record
  1.  .I +PIEN1 D
  1.  ..K SDFDA,SDIEN,SDMSG
  1.  ..S SDFDA=$NA(SDFDA(409.8451,PIEN1_","_PIEN_","))
  1.  ..I $P(SDINOD,"^",4)'="" S SDACT=1
  1.  .;
  1.  .;add new preference record
  1.  .I '+PIEN1 D
  1.  ..K SDFDA,SDIEN,SDMSG
  1.  ..S SDFDA=$NA(SDFDA(409.8451,"+1,"_PIEN_","))
  1.  ..S @SDFDA@(.01)=SDPREF($P(SDINOD,"|",1))   ;preference code
  1.  .. ;
  1.  .. ;  Change date/time conversion so midnight is handled properly.  wtc 694 5/17/18
  1.  .. ;
  1.  .. S X=$P(SDINOD,"|",2),Y=$$NETTOFM^SDECDATE(X,"Y","N") S @SDFDA@(2)=$S(Y=-1:$$NOW^XLFDT,1:Y)  ;date/time added
  1.  ..S @SDFDA@(3)=$S(+$P(SDINOD,"|",3):+$P(SDINOD,"|",3),1:DUZ)     ;added by user
  1.  ..D UPDATE^DIE("","SDFDA","SDIEN","SDMSG")
  1.  ..S PIEN1=SDIEN(1)
  1.  .;add/edit remark
  1.  .;alb/sat 658 begin modification to split REMARK into multiple lines
  1.  .I +PIEN1,REMARK'="" D   ;$P(SDINOD,"|",6)'="" D
  1.  ..K SDMSG
  1.  ..I REMARK="@" D WP^DIE(409.8451,PIEN1_","_PIEN_",",6,"","@","SDMSG")
  1.  ..I REMARK'="@" D WP^SDECUTL(.SDREMARK,REMARK) I $D(SDREMARK) D WP^DIE(409.8451,PIEN1_","_PIEN_",",6,"","SDREMARK","SDMSG")
  1.  .;alb/sat 658 end modification
  1.  ;
  1.  S SDECI=SDECI+1 S @SDECY@(SDECI)="0^COMPLETED"_$C(30,31)
  1.  I SDACT=1 S @SDECY@(SDECI)="0^COMPLETED - INACTIVE info sent nothing updated"_$C(30,31)
  1.  Q
  1.  ;
  1.  ;===============================================================
  1.  ;
  1. PREFGET(SDECY,DFN,INAC) ; Get values from SDEC PREFERENCES AND SPECIAL NEEDS file
  1.  ;PREFGET(SDECY,DFN,INAC)  external parameter tag is in SDEC
  1.  ;INPUT:
  1.  ;  DFN  = (integer) Patient ID - Pointer to the PATIENT file 2  (lookup by name is not accurate if duplicates)
  1.  ;  INAC = (optional) include inactive entries
  1.  ;RETURN:
  1.  ; Successful Return:
  1.  ;  Global array containing a list of preferences in which each array entry contains preference data separated by ^:
  1.  ;         the ^ pieces are as follows:
  1.  ;          1. (integer)        Patient ID - pointer to PATIENT file
  1.  ;          2. (text)           Preference text
  1.  ;          3. (date/time)      Date/Time preference added in external format - defaults to NOW
  1.  ;          4. (integer)        Added by User - Pointer to NEW PERSON file - defaults to Current User
  1.  ;          5. (text)           Added by User Name
  1.  ;          6. (date/time)      Date/Time Inactivated in external format
  1.  ;          7. (integer)        Inactivated by user - Pointer to NEW PERSON file
  1.  ;          8. (text)           Inactivated by user Name
  1.  ;          9. (text)      Remarks are returned as a single string of text that may be delimited by carriage return/line feed $c(13,10).
  1.  ;             1         2               3                4
  1.  ;      "T00020DFN^T00030PREF_TEXT^T00020DATE_ADDED^T00030ADDED_BY_USER_IEN"
  1.  ;              5                        6                      7
  1.  ;       ^T00030ADDED_BY_USER_NAME^T00020DATE_INACTIVATED^T00030INACTIVATED_BY_USER_IEN"
  1.  ;              8                              9
  1.  ;       ^T00030INACTIVATED_BY_USER_NAME^T00100REMARKS"_$C(30)
  1.  ; Caught Exception Return:
  1.  ;   A single entry in the Global Array in the format "-1^<error text>"
  1.  ;   "T00020RETURNCODE^T00100TEXT"
  1.  ; Unexpected Exception Return:
  1.  ;     Handled by the RPC Broker.
  1.  ;     M errors are trapped by the use of M and Kernel error handling.
  1.  ;     The RPC execution stops and the RPC Broker sends the error generated
  1.  ;     text back to the client.
  1.  ;
  1.  N PIEN,PIEN1,PIEN1NOD
  1.  N SDFDA,SDI,SDIEN,SDINOD,SDMSG,SDPREF,SDREMARK,SDTMP,SDWP,SDWPA
  1.  N X
  1.  S SDECI=0
  1.  K ^TMP("SDEC",$J)
  1.  S SDECY="^TMP(""SDEC"","_$J_")"
  1.  ; data header
  1.  S @SDECY@(SDECI)="T00020RETURNCODE^T00100TEXT"_$C(30)
  1.  ;check for valid Patient
  1.  I '+$G(DFN) D ERR1^SDECERR(-1,"Invalid Patient ID.",.SDECI,SDECY) Q
  1.  I '$D(^DPT(DFN,0)) D ERR1^SDECERR(-1,"Invalid Patient ID.",.SDECI,SDECY) Q
  1.  ;              1         2               3                4
  1.  S SDTMP="T00020DFN^T00030PREF_TEXT^T00020DATE_ADDED^T00030ADDED_BY_USER_IEN"
  1.  ;                     5                        6                      7
  1.  S SDTMP=SDTMP_"^T00030ADDED_BY_USER_NAME^T00020DATE_INACTIVATED^T00030INACTIVATED_BY_USER_IEN"
  1.  ;                     8                              9
  1.  S SDTMP=SDTMP_"^T00030INACTIVATED_BY_USER_NAME^T00100REMARKS"_$C(30)
  1.  S @SDECY@(SDECI)=SDTMP
  1.  ;check for existing patient entry in SDEC PREFERENCES AND SPECIAL NEEDS file
  1.  S PIEN=$O(^SDEC(409.845,"B",DFN,0))
  1.  I '+PIEN S @SDECY@(SDECI)=@SDECY@(SDECI)_$C(31) Q
  1.  D PREF1(.SDPREF)    ;SDPREF(<CODE>)=<TEXT>
  1.  S PIEN1=0 F  S PIEN1=$O(^SDEC(409.845,PIEN,1,PIEN1)) Q:PIEN1'>0  D
  1.  .S PIEN1NOD=^SDEC(409.845,PIEN,1,PIEN1,0)
  1.  .I '+$G(INAC) Q:$P(PIEN1NOD,U,4)'=""
  1.  . ;
  1.  . ;  Change date/time conversion so midnight is handled properly.  wtc 694 5/17/18
  1.  . ;
  1.  . S SDTMP=DFN_U_SDPREF($P(PIEN1NOD,U,1))_U_$$FMTONET^SDECDATE($P(PIEN1NOD,U,2))_U_$P(PIEN1NOD,U,3)_U_$$GET1^DIQ(200,+$P(PIEN1NOD,U,3)_",",.01)
  1.  . S SDTMP=SDTMP_U_U_U
  1.  .;get remark
  1.  .K SDWP S X=$$GET1^DIQ(409.8451,PIEN1_","_PIEN_",",6,"","SDWP","SDMSG")
  1.  .S SDWPA=""
  1.  .S SDI=0 F  S SDI=$O(SDWP(SDI)) Q:SDI=""  D
  1.  ..S SDWPA=$S(SDWPA'="":SDWPA_$C(13,10),1:"")_$TR(SDWP(SDI),"^"," ")   ;alb/sat 658 - strip out ^
  1.  .S:SDWPA'="" SDTMP=SDTMP_U_SDWPA
  1.  .S SDECI=SDECI+1 S @SDECY@(SDECI)=SDTMP_$C(30)
  1.  S @SDECY@(SDECI)=@SDECY@(SDECI)_$C(31)
  1.  Q
  1.  ;
  1.  ;=================================================
  1.  ;
  1. PREFGETV(SDECY) ;
  1.  ;PREFGETV(SDECY)  external parameter tag is in SDEC
  1.  ;INPUT: none
  1.  ;RETURN:
  1.  ; Successful Return:
  1.  ;  Global array containing a list of the valid Preferences in which each array entry contains the preference text.
  1.  ; Caught Exception Return:
  1.  ;   A single entry in the Global Array in the format "-1^<error text>"
  1.  ;   "T00020RETURNCODE^T00100TEXT"
  1.  ; Unexpected Exception Return:
  1.  ;     Handled by the RPC Broker.
  1.  ;     M errors are trapped by the use of M and Kernel error handling.
  1.  ;     The RPC execution stops and the RPC Broker sends the error generated
  1.  ;     text back to the client.
  1.  N SDI,SDX,SDXI,SDECI
  1.  S SDECI=0
  1.  K ^TMP("SDEC",$J)
  1.  S SDECY="^TMP(""SDEC"","_$J_")"
  1.  ; data header
  1.  S @SDECY@(SDECI)="T00030TEXT"_$C(30)
  1.  S SDX=$P($G(^DD(409.8451,.01,0)),U,3)
  1.  F SDI=1:1:$L(SDX,";") D
  1.  .S SDXI=$P(SDX,";",SDI)
  1.  .Q:SDXI=""
  1.  .S SDECI=SDECI+1 S @SDECY@(SDECI)=$P(SDXI,":",2)_$C(30)
  1.  S @SDECY@(SDECI)=@SDECY@(SDECI)_$C(31)
  1.  Q
  1.  ;
  1.  ;=================================================
  1.  ;
  1. PREF(PREF) ;
  1.  N SDI,SDX,SDXI
  1.  S SDX=$P($G(^DD(409.8451,.01,0)),U,3)
  1.  F SDI=1:1:$L(SDX,";") D
  1.  .S SDXI=$P(SDX,";",SDI)
  1.  .Q:SDXI=""
  1.  .S PREF($P(SDXI,":",2))=$P(SDXI,":",1)
  1.  Q
  1.  ;
  1. PREF1(PREF) ;
  1.  N SDI,SDX,SDXI
  1.  S SDX=$P($G(^DD(409.8451,.01,0)),U,3)
  1.  F SDI=1:1:$L(SDX,";") D
  1.  .S SDXI=$P(SDX,";",SDI)
  1.  .Q:SDXI=""
  1.  .S PREF($P(SDXI,":",1))=$P(SDXI,":",2)
  1.  Q
  1.  ;
  1. TIME(TIME)  ;
  1.  ;INPUT:
  1.  ; TIME = date/time in external form
  1.  N RET,X,Y,%DT
  1.  S RET=""
  1.  S TIME=$G(TIME)
  1.  I TIME'="" S %DT="TX" S X=TIME D ^%DT S RET=Y I Y=-1 S RET=""
  1.  I RET="" S RET=$E($$NOW^XLFDT,1,12)
  1.  Q RET
  1.  ;
  1. USER(USER)  ;
  1.  ;INPUT:
  1.  ; USER = user pointer to NEW PERSON file
  1.  N RET
  1.  S RET=""
  1.  S USER=$G(USER)
  1.  I USER'="" I $D(^VA(200,USER,0)) S RET=USER
  1.  I RET="" S RET=DUZ
  1.  Q RET