SDEC49 ;ALB/SAT,WTC - VISTA SCHEDULING RPCS ;Feb 12, 2020@15:22
;;5.3;Scheduling;**627,658,694**;Aug 13, 1993;Build 61
;
; ICR
; ---
; 10060 - #200 new person
Q
;
PREFSET(SDECY,DFN,PREF,REMARK) ; Set values to SDEC PREFERENCES AND SPECIAL NEEDS file ;alb/sat add REMARK
;PREFSET(SDECY,DFN,PREF,REMARK) external parameter tag is in SDEC
;INPUT:
; DFN = (integer) Patient ID - Pointer to the PATIENT file 2 (lookup by name is not accurate if duplicates)
; PREF = List of preference data separated by ^
; Each ^ piece contains the following Pipe pieces |:
; 1. (required) Preference text; precede text with @ to delete
; use SDEC PREFGETV to get current valid values.
; Valid values at this time are:
; GENDER SPECIFIC PROVIDER
; HEARING IMPAIRED
; LANGUAGE PREFERENCE
; NEEDS ESCORT
; ON STRETCHER
; SPECIAL MODE OF TRANSPORTATION
; MORNING
; AFTERNOON
; MONDAY
; TUESDAY
; WEDNESDAY
; THURSDAY
; FRIDAY
; 2. (optional) Date/Time preference added in external format - defaults to NOW (new entry only)
; 3. (optional) Added by User - Pointer to NEW PERSON file - defaults to Current User (new entry only)
; 4. (optional) Date/Time Inactivated in external format default to NOW if active flag set to inactive
; 5. (optional) Inactivated by user - Pointer to NEW PERSON file default to current user if active flag set to inactive
; 6. (optional ) <not used>
; 7. (optional) active flag 0=inactive; 1=active; default to active
; REMARK = Remarks single string of text will be converted to word processor format.
; @ deletes previous Remark
;RETURN:
; Successful Return:
; A single entry in the Global Array in the format "0^<optional msg text>"
; "T00020RETURNCODE^T00100TEXT"
; Caught Exception Return:
; A single entry in the Global Array in the format "-1^<error text>"
; "T00020RETURNCODE^T00100TEXT"
; Unexpected Exception Return:
; Handled by the RPC Broker.
; M errors are trapped by the use of M and Kernel error handling.
; The RPC execution stops and the RPC Broker sends the error generated
; text back to the client.
;
N PIEN,PIEN1,SDFDA,SDI,SDIEN,SDACT,SDINOD,SDINOD1,SDMSG,SDPREF,SDQUIT,SDREMARK,X,Y,%DT
S SDECI=0
K ^TMP("SDEC",$J)
S SDECY="^TMP(""SDEC"","_$J_")"
; data header
S @SDECY@(0)="T00020RETURNCODE^T00100TEXT"_$C(30)
;validate REMARK ;alb/sat 658
S REMARK=$TR($G(REMARK),"^"," ")
;check for valid Patient
I '+DFN D ERR1^SDECERR(1,"Invalid Patient ID.",.SDECI,SDECY) Q
I '$D(^DPT(DFN,0)) D ERR1^SDECERR(1,"Invalid Patient ID.",.SDECI,SDECY) Q
;check for existing patient entry
S PIEN=$O(^SDEC(409.845,"B",DFN,0))
;add new patient entry
I 'PIEN D
.S SDFDA(409.845,"+1,",.01)=DFN
.D UPDATE^DIE("","SDFDA","SDIEN","SDMSG")
.S PIEN=$G(SDIEN(1))
I 'PIEN D ERR1^SDECERR(1,"Error adding patient "_DFN_" to SDEC PREFERENCES AND SPECIAL NEEDS file.",.SDECI,SDECY) Q
;get list of valid preferences
D PREF(.SDPREF) ;SDPREF(<TEXT>)=<CODE>
;add preference data
F SDI=1:1:$L(PREF,"^") D
.S SDINOD=$P(PREF,"^",SDI)
.Q:SDINOD=""
.I $E($P(SDINOD,"|",1),1)="@" D Q
..I $D(SDPREF($P($P(SDINOD,"|",1),"@",2))) D Q
...;delete this preference if @
...K SDFDA,SDMSG
...S PIEN1=$O(^SDEC(409.845,PIEN,1,"B",SDPREF($P($P(SDINOD,"|",1),"@",2)),0))
...Q:'PIEN1
...S SDFDA=$NA(SDFDA(409.8451,PIEN1_","_PIEN_","))
...S @SDFDA@(.01)="@"
...D UPDATE^DIE("","SDFDA","","SDMSG")
.I '$D(SDPREF($P(SDINOD,"|",1))) Q
.S PIEN1=$O(^SDEC(409.845,PIEN,1,"B",SDPREF($P(SDINOD,"|",1)),0))
.;quit if no changes to this preference
.;I PIEN1="",$P(SDINOD,"|",7)'=1 Q
.S SDQUIT=0
.;I PIEN1'="" D
.;.D GETS^DIQ(409.8451,PIEN1_","_PIEN_",","**","IE","SDINOD1","WLMSG")
.;.S SDACT=SDINOD1(409.8451,PIEN1_","_PIEN_",",4,"I")'="" ;)&(SDINOD1(409.8451,PIEN1_","_PIEN_",",5,"I")="")
.;.S SDQUIT=$S((SDACT=1)&($P(SDINOD,"|",7)=1):1,(SDACT'=1)&($P(SDINOD,"|",7)'=1):1,1:0)
.Q:+SDQUIT
.;edit preference record
.I +PIEN1 D
..K SDFDA,SDIEN,SDMSG
..S SDFDA=$NA(SDFDA(409.8451,PIEN1_","_PIEN_","))
..;I $P(SDINOD,"|",2)'="" S %DT="TX" S X=$P(SDINOD,"|",2) D ^%DT S @SDFDA@(2)=$S(Y=-1:$$NOW^XLFDT,1:Y) ;date/time added
..;I $P(SDINOD,"|",3)'="" S @SDFDA@(3)=$S(+$P(SDINOD,"|",3):+$P(SDINOD,"|",3),1:DUZ) ;added by user
..S @SDFDA@(4)=$S($P(SDINOD,"|",7)=1:"",1:$$TIME($P(SDINOD,"|",4))) ;1=active
..S @SDFDA@(5)=$S($P(SDINOD,"|",7)=1:"",1:$$USER($P(SDINOD,"|",5))) ;1=active
..D UPDATE^DIE("","SDFDA","","SDMSG")
.;
.;add new preference record
.I '+PIEN1 D
..K SDFDA,SDIEN,SDMSG
..S SDFDA=$NA(SDFDA(409.8451,"+1,"_PIEN_","))
..S @SDFDA@(.01)=SDPREF($P(SDINOD,"|",1)) ;preference code
.. ;
.. ; Change date/time conversion so midnight is handled properly. wtc 694 5/17/18
.. ;
.. S X=$P(SDINOD,"|",2),Y=$$NETTOFM^SDECDATE(X,"Y","N") S @SDFDA@(2)=$S(Y=-1:$$NOW^XLFDT,1:Y) ;date/time added
.. ;S %DT="TX" S X=$P(SDINOD,"|",2) D ^%DT S @SDFDA@(2)=$S(Y=-1:$$NOW^XLFDT,1:Y) ;date/time added
..S @SDFDA@(3)=$S(+$P(SDINOD,"|",3):+$P(SDINOD,"|",3),1:DUZ) ;added by user
..S @SDFDA@(4)=$S($P(SDINOD,"|",7)=1:"",1:$$TIME($P(SDINOD,"|",4)))
..S @SDFDA@(5)=$S($P(SDINOD,"|",7)=1:"",1:$$USER($P(SDINOD,"|",5)))
..;I $P(SDINOD,"|",4)'="" S %DT="TX" S X=$P(SDINOD,"|",4) D ^%DT I Y'=-1 S @SDFDA@(4)=Y
..;I +$P(SDINOD,"|",5) S @SDFDA@(5)=+$P(SDINOD,"|",5)
..D UPDATE^DIE("","SDFDA","SDIEN","SDMSG")
..S PIEN1=SDIEN(1)
.;add/edit remark
.;I +PIEN1,$P(SDINOD,"|",6)'="" D
.;.K SDMSG
.;.S SDREMARK=$P(SDINOD,"|",6)
.;.I SDREMARK]"" S SDREMARK(.5)=SDREMARK,SDREMARK="" D
.;..D WP^DIE(409.8451,PIEN1_","_PIEN_",",6,"","SDREMARK","SDMSG")
.;alb/sat 658 begin modification to split REMARK into multiple lines
.I +PIEN1,REMARK'="" D ;$P(SDINOD,"|",6)'="" D
..K SDMSG
..I REMARK="@" D WP^DIE(409.8451,PIEN1_","_PIEN_",",6,"","@","SDMSG")
..I REMARK'="@" D WP^SDECUTL(.SDREMARK,REMARK) I $D(SDREMARK) D WP^DIE(409.8451,PIEN1_","_PIEN_",",6,"","SDREMARK","SDMSG")
.;alb/sat 658 end modification
;
S SDECI=SDECI+1 S @SDECY@(SDECI)="0^COMPLETED"_$C(30,31)
Q
;
;===============================================================
;
PREFGET(SDECY,DFN,INAC) ; Get values from SDEC PREFERENCES AND SPECIAL NEEDS file
;PREFGET(SDECY,DFN,INAC) external parameter tag is in SDEC
;INPUT:
; DFN = (integer) Patient ID - Pointer to the PATIENT file 2 (lookup by name is not accurate if duplicates)
; INAC = (optional) include inactive entries
;RETURN:
; Successful Return:
; Global array containing a list of preferences in which each array entry contains preference data separated by ^:
; the ^ pieces are as follows:
; 1. (integer) Patient ID - pointer to PATIENT file
; 2. (text) Preference text
; 3. (date/time) Date/Time preference added in external format - defaults to NOW
; 4. (integer) Added by User - Pointer to NEW PERSON file - defaults to Current User
; 5. (text) Added by User Name
; 6. (date/time) Date/Time Inactivated in external format
; 7. (integer) Inactivated by user - Pointer to NEW PERSON file
; 8. (text) Inactivated by user Name
; 9. (text) Remarks are returned as a single string of text that may be delimited by carriage return/line feed $c(13,10).
; 1 2 3 4
; "T00020DFN^T00030PREF_TEXT^T00020DATE_ADDED^T00030ADDED_BY_USER_IEN"
; 5 6 7
; ^T00030ADDED_BY_USER_NAME^T00020DATE_INACTIVATED^T00030INACTIVATED_BY_USER_IEN"
; 8 9
; ^T00030INACTIVATED_BY_USER_NAME^T00100REMARKS"_$C(30)
; Caught Exception Return:
; A single entry in the Global Array in the format "-1^<error text>"
; "T00020RETURNCODE^T00100TEXT"
; Unexpected Exception Return:
; Handled by the RPC Broker.
; M errors are trapped by the use of M and Kernel error handling.
; The RPC execution stops and the RPC Broker sends the error generated
; text back to the client.
;
N PIEN,PIEN1,PIEN1NOD
N SDFDA,SDI,SDIEN,SDINOD,SDMSG,SDPREF,SDREMARK,SDTMP,SDWP,SDWPA
N X
S SDECI=0
K ^TMP("SDEC",$J)
S SDECY="^TMP(""SDEC"","_$J_")"
; data header
S @SDECY@(SDECI)="T00020RETURNCODE^T00100TEXT"_$C(30)
;check for valid Patient
I '+$G(DFN) D ERR1^SDECERR(-1,"Invalid Patient ID.",.SDECI,SDECY) Q
I '$D(^DPT(DFN,0)) D ERR1^SDECERR(-1,"Invalid Patient ID.",.SDECI,SDECY) Q
; 1 2 3 4
S SDTMP="T00020DFN^T00030PREF_TEXT^T00020DATE_ADDED^T00030ADDED_BY_USER_IEN"
; 5 6 7
S SDTMP=SDTMP_"^T00030ADDED_BY_USER_NAME^T00020DATE_INACTIVATED^T00030INACTIVATED_BY_USER_IEN"
; 8 9
S SDTMP=SDTMP_"^T00030INACTIVATED_BY_USER_NAME^T00100REMARKS"_$C(30)
S @SDECY@(SDECI)=SDTMP
;check for existing patient entry in SDEC PREFERENCES AND SPECIAL NEEDS file
S PIEN=$O(^SDEC(409.845,"B",DFN,0))
I '+PIEN S @SDECY@(SDECI)=@SDECY@(SDECI)_$C(31) Q
D PREF1(.SDPREF) ;SDPREF(<CODE>)=<TEXT>
S PIEN1=0 F S PIEN1=$O(^SDEC(409.845,PIEN,1,PIEN1)) Q:PIEN1'>0 D
.S PIEN1NOD=^SDEC(409.845,PIEN,1,PIEN1,0)
.I '+$G(INAC) Q:$P(PIEN1NOD,U,4)'=""
. ;
. ; Change date/time conversion so midnight is handled properly. wtc 694 5/17/18
. ;
. ;S SDTMP=DFN_U_SDPREF($P(PIEN1NOD,U,1))_U_$$FMTE^XLFDT($P(PIEN1NOD,U,2),8)_U_$P(PIEN1NOD,U,3)_U_$P($G(^VA(200,+$P(PIEN1NOD,U,3),0)),U,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)
. ;S SDTMP=SDTMP_U_$S($P(PIEN1NOD,U,4)'="":$$FMTE^XLFDT($P(PIEN1NOD,U,4),8),1:"")_U_$P(PIEN1NOD,U,5)
. S SDTMP=SDTMP_U_$S($P(PIEN1NOD,U,4)'="":$$FMTONET^SDECDATE($P(PIEN1NOD,U,4)),1:"")_U_$P(PIEN1NOD,U,5) ;
.S SDTMP=SDTMP_U_$S($P(PIEN1NOD,U,5)'="":$P($G(^VA(200,+$P(PIEN1NOD,U,5),0)),U,1),1:"")
.;get remark
.K SDWP S X=$$GET1^DIQ(409.8451,PIEN1_","_PIEN_",",6,"","SDWP","SDMSG")
.S SDWPA=""
.S SDI=0 F S SDI=$O(SDWP(SDI)) Q:SDI="" D
..S SDWPA=$S(SDWPA'="":SDWPA_$C(13,10),1:"")_$TR(SDWP(SDI),"^"," ") ;alb/sat 658 - strip out ^
.S:SDWPA'="" SDTMP=SDTMP_U_SDWPA
.S SDECI=SDECI+1 S @SDECY@(SDECI)=SDTMP_$C(30)
S @SDECY@(SDECI)=@SDECY@(SDECI)_$C(31)
Q
;
;=================================================
;
PREFGETV(SDECY) ;
;PREFGETV(SDECY) external parameter tag is in SDEC
;INPUT: none
;RETURN:
; Successful Return:
; Global array containing a list of the valid Preferences in which each array entry contains the preference text.
; Caught Exception Return:
; A single entry in the Global Array in the format "-1^<error text>"
; "T00020RETURNCODE^T00100TEXT"
; Unexpected Exception Return:
; Handled by the RPC Broker.
; M errors are trapped by the use of M and Kernel error handling.
; The RPC execution stops and the RPC Broker sends the error generated
; text back to the client.
N SDI,SDX,SDXI,SDECI
S SDECI=0
K ^TMP("SDEC",$J)
S SDECY="^TMP(""SDEC"","_$J_")"
; data header
S @SDECY@(SDECI)="T00030TEXT"_$C(30)
S SDX=$P($G(^DD(409.8451,.01,0)),U,3)
F SDI=1:1:$L(SDX,";") D
.S SDXI=$P(SDX,";",SDI)
.Q:SDXI=""
.S SDECI=SDECI+1 S @SDECY@(SDECI)=$P(SDXI,":",2)_$C(30)
S @SDECY@(SDECI)=@SDECY@(SDECI)_$C(31)
Q
;
;=================================================
;
PREF(PREF) ;
N SDI,SDX,SDXI
S SDX=$P($G(^DD(409.8451,.01,0)),U,3)
F SDI=1:1:$L(SDX,";") D
.S SDXI=$P(SDX,";",SDI)
.Q:SDXI=""
.S PREF($P(SDXI,":",2))=$P(SDXI,":",1)
Q
;
PREF1(PREF) ;
N SDI,SDX,SDXI
S SDX=$P($G(^DD(409.8451,.01,0)),U,3)
F SDI=1:1:$L(SDX,";") D
.S SDXI=$P(SDX,";",SDI)
.Q:SDXI=""
.S PREF($P(SDXI,":",1))=$P(SDXI,":",2)
Q
;
TIME(TIME) ;
;INPUT:
; TIME = date/time in external form
N RET,X,Y,%DT
S RET=""
S TIME=$G(TIME)
I TIME'="" S %DT="TX" S X=TIME D ^%DT S RET=Y I Y=-1 S RET=""
I RET="" S RET=$E($$NOW^XLFDT,1,12)
Q RET
;
USER(USER) ;
;INPUT:
; USER = user pointer to NEW PERSON file
N RET
S RET=""
S USER=$G(USER)
I USER'="" I $D(^VA(200,USER,0)) S RET=USER
I RET="" S RET=DUZ
Q RET
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDEC49 13002 printed Dec 13, 2024@02:50:40 Page 2
SDEC49 ;ALB/SAT,WTC - VISTA SCHEDULING RPCS ;Feb 12, 2020@15:22
+1 ;;5.3;Scheduling;**627,658,694**;Aug 13, 1993;Build 61
+2 ;
+3 ; ICR
+4 ; ---
+5 ; 10060 - #200 new person
+6 QUIT
+7 ;
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
+2 ;INPUT:
+3 ; DFN = (integer) Patient ID - Pointer to the PATIENT file 2 (lookup by name is not accurate if duplicates)
+4 ; PREF = List of preference data separated by ^
+5 ; Each ^ piece contains the following Pipe pieces |:
+6 ; 1. (required) Preference text; precede text with @ to delete
+7 ; use SDEC PREFGETV to get current valid values.
+8 ; Valid values at this time are:
+9 ; GENDER SPECIFIC PROVIDER
+10 ; HEARING IMPAIRED
+11 ; LANGUAGE PREFERENCE
+12 ; NEEDS ESCORT
+13 ; ON STRETCHER
+14 ; SPECIAL MODE OF TRANSPORTATION
+15 ; MORNING
+16 ; AFTERNOON
+17 ; MONDAY
+18 ; TUESDAY
+19 ; WEDNESDAY
+20 ; THURSDAY
+21 ; FRIDAY
+22 ; 2. (optional) Date/Time preference added in external format - defaults to NOW (new entry only)
+23 ; 3. (optional) Added by User - Pointer to NEW PERSON file - defaults to Current User (new entry only)
+24 ; 4. (optional) Date/Time Inactivated in external format default to NOW if active flag set to inactive
+25 ; 5. (optional) Inactivated by user - Pointer to NEW PERSON file default to current user if active flag set to inactive
+26 ; 6. (optional ) <not used>
+27 ; 7. (optional) active flag 0=inactive; 1=active; default to active
+28 ; REMARK = Remarks single string of text will be converted to word processor format.
+29 ; @ deletes previous Remark
+30 ;RETURN:
+31 ; Successful Return:
+32 ; A single entry in the Global Array in the format "0^<optional msg text>"
+33 ; "T00020RETURNCODE^T00100TEXT"
+34 ; Caught Exception Return:
+35 ; A single entry in the Global Array in the format "-1^<error text>"
+36 ; "T00020RETURNCODE^T00100TEXT"
+37 ; Unexpected Exception Return:
+38 ; Handled by the RPC Broker.
+39 ; M errors are trapped by the use of M and Kernel error handling.
+40 ; The RPC execution stops and the RPC Broker sends the error generated
+41 ; text back to the client.
+42 ;
+43 NEW PIEN,PIEN1,SDFDA,SDI,SDIEN,SDACT,SDINOD,SDINOD1,SDMSG,SDPREF,SDQUIT,SDREMARK,X,Y,%DT
+44 SET SDECI=0
+45 KILL ^TMP("SDEC",$JOB)
+46 SET SDECY="^TMP(""SDEC"","_$JOB_")"
+47 ; data header
+48 SET @SDECY@(0)="T00020RETURNCODE^T00100TEXT"_$CHAR(30)
+49 ;validate REMARK ;alb/sat 658
+50 SET REMARK=$TRANSLATE($GET(REMARK),"^"," ")
+51 ;check for valid Patient
+52 IF '+DFN
DO ERR1^SDECERR(1,"Invalid Patient ID.",.SDECI,SDECY)
QUIT
+53 IF '$DATA(^DPT(DFN,0))
DO ERR1^SDECERR(1,"Invalid Patient ID.",.SDECI,SDECY)
QUIT
+54 ;check for existing patient entry
+55 SET PIEN=$ORDER(^SDEC(409.845,"B",DFN,0))
+56 ;add new patient entry
+57 IF 'PIEN
Begin DoDot:1
+58 SET SDFDA(409.845,"+1,",.01)=DFN
+59 DO UPDATE^DIE("","SDFDA","SDIEN","SDMSG")
+60 SET PIEN=$GET(SDIEN(1))
End DoDot:1
+61 IF 'PIEN
DO ERR1^SDECERR(1,"Error adding patient "_DFN_" to SDEC PREFERENCES AND SPECIAL NEEDS file.",.SDECI,SDECY)
QUIT
+62 ;get list of valid preferences
+63 ;SDPREF(<TEXT>)=<CODE>
DO PREF(.SDPREF)
+64 ;add preference data
+65 FOR SDI=1:1:$LENGTH(PREF,"^")
Begin DoDot:1
+66 SET SDINOD=$PIECE(PREF,"^",SDI)
+67 if SDINOD=""
QUIT
+68 IF $EXTRACT($PIECE(SDINOD,"|",1),1)="@"
Begin DoDot:2
+69 IF $DATA(SDPREF($PIECE($PIECE(SDINOD,"|",1),"@",2)))
Begin DoDot:3
+70 ;delete this preference if @
+71 KILL SDFDA,SDMSG
+72 SET PIEN1=$ORDER(^SDEC(409.845,PIEN,1,"B",SDPREF($PIECE($PIECE(SDINOD,"|",1),"@",2)),0))
+73 if 'PIEN1
QUIT
+74 SET SDFDA=$NAME(SDFDA(409.8451,PIEN1_","_PIEN_","))
+75 SET @SDFDA@(.01)="@"
+76 DO UPDATE^DIE("","SDFDA","","SDMSG")
End DoDot:3
QUIT
End DoDot:2
QUIT
+77 IF '$DATA(SDPREF($PIECE(SDINOD,"|",1)))
QUIT
+78 SET PIEN1=$ORDER(^SDEC(409.845,PIEN,1,"B",SDPREF($PIECE(SDINOD,"|",1)),0))
+79 ;quit if no changes to this preference
+80 ;I PIEN1="",$P(SDINOD,"|",7)'=1 Q
+81 SET SDQUIT=0
+82 ;I PIEN1'="" D
+83 ;.D GETS^DIQ(409.8451,PIEN1_","_PIEN_",","**","IE","SDINOD1","WLMSG")
+84 ;.S SDACT=SDINOD1(409.8451,PIEN1_","_PIEN_",",4,"I")'="" ;)&(SDINOD1(409.8451,PIEN1_","_PIEN_",",5,"I")="")
+85 ;.S SDQUIT=$S((SDACT=1)&($P(SDINOD,"|",7)=1):1,(SDACT'=1)&($P(SDINOD,"|",7)'=1):1,1:0)
+86 if +SDQUIT
QUIT
+87 ;edit preference record
+88 IF +PIEN1
Begin DoDot:2
+89 KILL SDFDA,SDIEN,SDMSG
+90 SET SDFDA=$NAME(SDFDA(409.8451,PIEN1_","_PIEN_","))
+91 ;I $P(SDINOD,"|",2)'="" S %DT="TX" S X=$P(SDINOD,"|",2) D ^%DT S @SDFDA@(2)=$S(Y=-1:$$NOW^XLFDT,1:Y) ;date/time added
+92 ;I $P(SDINOD,"|",3)'="" S @SDFDA@(3)=$S(+$P(SDINOD,"|",3):+$P(SDINOD,"|",3),1:DUZ) ;added by user
+93 ;1=active
SET @SDFDA@(4)=$SELECT($PIECE(SDINOD,"|",7)=1:"",1:$$TIME($PIECE(SDINOD,"|",4)))
+94 ;1=active
SET @SDFDA@(5)=$SELECT($PIECE(SDINOD,"|",7)=1:"",1:$$USER($PIECE(SDINOD,"|",5)))
+95 DO UPDATE^DIE("","SDFDA","","SDMSG")
End DoDot:2
+96 ;
+97 ;add new preference record
+98 IF '+PIEN1
Begin DoDot:2
+99 KILL SDFDA,SDIEN,SDMSG
+100 SET SDFDA=$NAME(SDFDA(409.8451,"+1,"_PIEN_","))
+101 ;preference code
SET @SDFDA@(.01)=SDPREF($PIECE(SDINOD,"|",1))
+102 ;
+103 ; Change date/time conversion so midnight is handled properly. wtc 694 5/17/18
+104 ;
+105 ;date/time added
SET X=$PIECE(SDINOD,"|",2)
SET Y=$$NETTOFM^SDECDATE(X,"Y","N")
SET @SDFDA@(2)=$SELECT(Y=-1:$$NOW^XLFDT,1:Y)
+106 ;S %DT="TX" S X=$P(SDINOD,"|",2) D ^%DT S @SDFDA@(2)=$S(Y=-1:$$NOW^XLFDT,1:Y) ;date/time added
+107 ;added by user
SET @SDFDA@(3)=$SELECT(+$PIECE(SDINOD,"|",3):+$PIECE(SDINOD,"|",3),1:DUZ)
+108 SET @SDFDA@(4)=$SELECT($PIECE(SDINOD,"|",7)=1:"",1:$$TIME($PIECE(SDINOD,"|",4)))
+109 SET @SDFDA@(5)=$SELECT($PIECE(SDINOD,"|",7)=1:"",1:$$USER($PIECE(SDINOD,"|",5)))
+110 ;I $P(SDINOD,"|",4)'="" S %DT="TX" S X=$P(SDINOD,"|",4) D ^%DT I Y'=-1 S @SDFDA@(4)=Y
+111 ;I +$P(SDINOD,"|",5) S @SDFDA@(5)=+$P(SDINOD,"|",5)
+112 DO UPDATE^DIE("","SDFDA","SDIEN","SDMSG")
+113 SET PIEN1=SDIEN(1)
End DoDot:2
+114 ;add/edit remark
+115 ;I +PIEN1,$P(SDINOD,"|",6)'="" D
+116 ;.K SDMSG
+117 ;.S SDREMARK=$P(SDINOD,"|",6)
+118 ;.I SDREMARK]"" S SDREMARK(.5)=SDREMARK,SDREMARK="" D
+119 ;..D WP^DIE(409.8451,PIEN1_","_PIEN_",",6,"","SDREMARK","SDMSG")
+120 ;alb/sat 658 begin modification to split REMARK into multiple lines
+121 ;$P(SDINOD,"|",6)'="" D
IF +PIEN1
IF REMARK'=""
Begin DoDot:2
+122 KILL SDMSG
+123 IF REMARK="@"
DO WP^DIE(409.8451,PIEN1_","_PIEN_",",6,"","@","SDMSG")
+124 IF REMARK'="@"
DO WP^SDECUTL(.SDREMARK,REMARK)
IF $DATA(SDREMARK)
DO WP^DIE(409.8451,PIEN1_","_PIEN_",",6,"","SDREMARK","SDMSG")
End DoDot:2
+125 ;alb/sat 658 end modification
End DoDot:1
+126 ;
+127 SET SDECI=SDECI+1
SET @SDECY@(SDECI)="0^COMPLETED"_$CHAR(30,31)
+128 QUIT
+129 ;
+130 ;===============================================================
+131 ;
PREFGET(SDECY,DFN,INAC) ; Get values from SDEC PREFERENCES AND SPECIAL NEEDS file
+1 ;PREFGET(SDECY,DFN,INAC) external parameter tag is in SDEC
+2 ;INPUT:
+3 ; DFN = (integer) Patient ID - Pointer to the PATIENT file 2 (lookup by name is not accurate if duplicates)
+4 ; INAC = (optional) include inactive entries
+5 ;RETURN:
+6 ; Successful Return:
+7 ; Global array containing a list of preferences in which each array entry contains preference data separated by ^:
+8 ; the ^ pieces are as follows:
+9 ; 1. (integer) Patient ID - pointer to PATIENT file
+10 ; 2. (text) Preference text
+11 ; 3. (date/time) Date/Time preference added in external format - defaults to NOW
+12 ; 4. (integer) Added by User - Pointer to NEW PERSON file - defaults to Current User
+13 ; 5. (text) Added by User Name
+14 ; 6. (date/time) Date/Time Inactivated in external format
+15 ; 7. (integer) Inactivated by user - Pointer to NEW PERSON file
+16 ; 8. (text) Inactivated by user Name
+17 ; 9. (text) Remarks are returned as a single string of text that may be delimited by carriage return/line feed $c(13,10).
+18 ; 1 2 3 4
+19 ; "T00020DFN^T00030PREF_TEXT^T00020DATE_ADDED^T00030ADDED_BY_USER_IEN"
+20 ; 5 6 7
+21 ; ^T00030ADDED_BY_USER_NAME^T00020DATE_INACTIVATED^T00030INACTIVATED_BY_USER_IEN"
+22 ; 8 9
+23 ; ^T00030INACTIVATED_BY_USER_NAME^T00100REMARKS"_$C(30)
+24 ; Caught Exception Return:
+25 ; A single entry in the Global Array in the format "-1^<error text>"
+26 ; "T00020RETURNCODE^T00100TEXT"
+27 ; Unexpected Exception Return:
+28 ; Handled by the RPC Broker.
+29 ; M errors are trapped by the use of M and Kernel error handling.
+30 ; The RPC execution stops and the RPC Broker sends the error generated
+31 ; text back to the client.
+32 ;
+33 NEW PIEN,PIEN1,PIEN1NOD
+34 NEW SDFDA,SDI,SDIEN,SDINOD,SDMSG,SDPREF,SDREMARK,SDTMP,SDWP,SDWPA
+35 NEW X
+36 SET SDECI=0
+37 KILL ^TMP("SDEC",$JOB)
+38 SET SDECY="^TMP(""SDEC"","_$JOB_")"
+39 ; data header
+40 SET @SDECY@(SDECI)="T00020RETURNCODE^T00100TEXT"_$CHAR(30)
+41 ;check for valid Patient
+42 IF '+$GET(DFN)
DO ERR1^SDECERR(-1,"Invalid Patient ID.",.SDECI,SDECY)
QUIT
+43 IF '$DATA(^DPT(DFN,0))
DO ERR1^SDECERR(-1,"Invalid Patient ID.",.SDECI,SDECY)
QUIT
+44 ; 1 2 3 4
+45 SET SDTMP="T00020DFN^T00030PREF_TEXT^T00020DATE_ADDED^T00030ADDED_BY_USER_IEN"
+46 ; 5 6 7
+47 SET SDTMP=SDTMP_"^T00030ADDED_BY_USER_NAME^T00020DATE_INACTIVATED^T00030INACTIVATED_BY_USER_IEN"
+48 ; 8 9
+49 SET SDTMP=SDTMP_"^T00030INACTIVATED_BY_USER_NAME^T00100REMARKS"_$CHAR(30)
+50 SET @SDECY@(SDECI)=SDTMP
+51 ;check for existing patient entry in SDEC PREFERENCES AND SPECIAL NEEDS file
+52 SET PIEN=$ORDER(^SDEC(409.845,"B",DFN,0))
+53 IF '+PIEN
SET @SDECY@(SDECI)=@SDECY@(SDECI)_$CHAR(31)
QUIT
+54 ;SDPREF(<CODE>)=<TEXT>
DO PREF1(.SDPREF)
+55 SET PIEN1=0
FOR
SET PIEN1=$ORDER(^SDEC(409.845,PIEN,1,PIEN1))
if PIEN1'>0
QUIT
Begin DoDot:1
+56 SET PIEN1NOD=^SDEC(409.845,PIEN,1,PIEN1,0)
+57 IF '+$GET(INAC)
if $PIECE(PIEN1NOD,U,4)'=""
QUIT
+58 ;
+59 ; Change date/time conversion so midnight is handled properly. wtc 694 5/17/18
+60 ;
+61 ;S SDTMP=DFN_U_SDPREF($P(PIEN1NOD,U,1))_U_$$FMTE^XLFDT($P(PIEN1NOD,U,2),8)_U_$P(PIEN1NOD,U,3)_U_$P($G(^VA(200,+$P(PIEN1NOD,U,3),0)),U,1)
+62 SET SDTMP=DFN_U_SDPREF($PIECE(PIEN1NOD,U,1))_U_$$FMTONET^SDECDATE($PIECE(PIEN1NOD,U,2))_U_$PIECE(PIEN1NOD,U,3)_U_$$GET1^DIQ(200,+$PIECE(PIEN1NOD,U,3)_",",.01)
+63 ;S SDTMP=SDTMP_U_$S($P(PIEN1NOD,U,4)'="":$$FMTE^XLFDT($P(PIEN1NOD,U,4),8),1:"")_U_$P(PIEN1NOD,U,5)
+64 ;
SET SDTMP=SDTMP_U_$SELECT($PIECE(PIEN1NOD,U,4)'="":$$FMTONET^SDECDATE($PIECE(PIEN1NOD,U,4)),1:"")_U_$PIECE(PIEN1NOD,U,5)
+65 SET SDTMP=SDTMP_U_$SELECT($PIECE(PIEN1NOD,U,5)'="":$PIECE($GET(^VA(200,+$PIECE(PIEN1NOD,U,5),0)),U,1),1:"")
+66 ;get remark
+67 KILL SDWP
SET X=$$GET1^DIQ(409.8451,PIEN1_","_PIEN_",",6,"","SDWP","SDMSG")
+68 SET SDWPA=""
+69 SET SDI=0
FOR
SET SDI=$ORDER(SDWP(SDI))
if SDI=""
QUIT
Begin DoDot:2
+70 ;alb/sat 658 - strip out ^
SET SDWPA=$SELECT(SDWPA'="":SDWPA_$CHAR(13,10),1:"")_$TRANSLATE(SDWP(SDI),"^"," ")
End DoDot:2
+71 if SDWPA'=""
SET SDTMP=SDTMP_U_SDWPA
+72 SET SDECI=SDECI+1
SET @SDECY@(SDECI)=SDTMP_$CHAR(30)
End DoDot:1
+73 SET @SDECY@(SDECI)=@SDECY@(SDECI)_$CHAR(31)
+74 QUIT
+75 ;
+76 ;=================================================
+77 ;
PREFGETV(SDECY) ;
+1 ;PREFGETV(SDECY) external parameter tag is in SDEC
+2 ;INPUT: none
+3 ;RETURN:
+4 ; Successful Return:
+5 ; Global array containing a list of the valid Preferences in which each array entry contains the preference text.
+6 ; Caught Exception Return:
+7 ; A single entry in the Global Array in the format "-1^<error text>"
+8 ; "T00020RETURNCODE^T00100TEXT"
+9 ; Unexpected Exception Return:
+10 ; Handled by the RPC Broker.
+11 ; M errors are trapped by the use of M and Kernel error handling.
+12 ; The RPC execution stops and the RPC Broker sends the error generated
+13 ; text back to the client.
+14 NEW SDI,SDX,SDXI,SDECI
+15 SET SDECI=0
+16 KILL ^TMP("SDEC",$JOB)
+17 SET SDECY="^TMP(""SDEC"","_$JOB_")"
+18 ; data header
+19 SET @SDECY@(SDECI)="T00030TEXT"_$CHAR(30)
+20 SET SDX=$PIECE($GET(^DD(409.8451,.01,0)),U,3)
+21 FOR SDI=1:1:$LENGTH(SDX,";")
Begin DoDot:1
+22 SET SDXI=$PIECE(SDX,";",SDI)
+23 if SDXI=""
QUIT
+24 SET SDECI=SDECI+1
SET @SDECY@(SDECI)=$PIECE(SDXI,":",2)_$CHAR(30)
End DoDot:1
+25 SET @SDECY@(SDECI)=@SDECY@(SDECI)_$CHAR(31)
+26 QUIT
+27 ;
+28 ;=================================================
+29 ;
PREF(PREF) ;
+1 NEW SDI,SDX,SDXI
+2 SET SDX=$PIECE($GET(^DD(409.8451,.01,0)),U,3)
+3 FOR SDI=1:1:$LENGTH(SDX,";")
Begin DoDot:1
+4 SET SDXI=$PIECE(SDX,";",SDI)
+5 if SDXI=""
QUIT
+6 SET PREF($PIECE(SDXI,":",2))=$PIECE(SDXI,":",1)
End DoDot:1
+7 QUIT
+8 ;
PREF1(PREF) ;
+1 NEW SDI,SDX,SDXI
+2 SET SDX=$PIECE($GET(^DD(409.8451,.01,0)),U,3)
+3 FOR SDI=1:1:$LENGTH(SDX,";")
Begin DoDot:1
+4 SET SDXI=$PIECE(SDX,";",SDI)
+5 if SDXI=""
QUIT
+6 SET PREF($PIECE(SDXI,":",1))=$PIECE(SDXI,":",2)
End DoDot:1
+7 QUIT
+8 ;
TIME(TIME) ;
+1 ;INPUT:
+2 ; TIME = date/time in external form
+3 NEW RET,X,Y,%DT
+4 SET RET=""
+5 SET TIME=$GET(TIME)
+6 IF TIME'=""
SET %DT="TX"
SET X=TIME
DO ^%DT
SET RET=Y
IF Y=-1
SET RET=""
+7 IF RET=""
SET RET=$EXTRACT($$NOW^XLFDT,1,12)
+8 QUIT RET
+9 ;
USER(USER) ;
+1 ;INPUT:
+2 ; USER = user pointer to NEW PERSON file
+3 NEW RET
+4 SET RET=""
+5 SET USER=$GET(USER)
+6 IF USER'=""
IF $DATA(^VA(200,USER,0))
SET RET=USER
+7 IF RET=""
SET RET=DUZ
+8 QUIT RET
