229 lines
9.5 KiB
Mathematica
229 lines
9.5 KiB
Mathematica
SDWLRP1 ;;IOFO BAY PINES/TEH - WAITING LIST - RPC;06/28/2002 ; 26 Aug 2002 1:25 PM ; Compiled April 16, 2007 10:15:05
|
|
;;5.3;scheduling;**263,273,485,497,446**;AUG 13 1993;Build 77
|
|
;
|
|
;
|
|
;******************************************************************
|
|
; CHANGE LOG
|
|
;
|
|
; DATE PATCH DESCRIPTION
|
|
; ---- ----- -----------
|
|
; 2/21/03 SD*5.3*273 Line new+12 added "/"
|
|
; 5/10/06 SD*5.3*446 New field: INTRA-transfer
|
|
OUTPUT(SDWLOUT,SDWLDFN) ;-FULL
|
|
; input:
|
|
; DFN = Patient
|
|
; Lookup uses Wait List data file (409.3) and returns the following data.
|
|
;
|
|
; output:
|
|
; SCOUT = location of data = ^TMP("SDWLG",$J,i,0)
|
|
; for i=1:number of records returned:
|
|
;
|
|
; Field Location Description
|
|
; 1 2 ORIGINATION DATE
|
|
; 2 3 INSTITUTION
|
|
; 3 4 CLINIC
|
|
; 4 5 WAIT LIST TYPE
|
|
; 5 6 SPECIFIC TEAM
|
|
; 5.1 22 MARKED OPEN (SPECIFIC TEAM)
|
|
; 6 7 SPECIFIC POSITION
|
|
; 6.1 23 MARKED OPEN (SPEICIFIC POSITION)
|
|
; 7 8 SERVICE /SPECIALTY
|
|
; 8 9 SPECIFIC CLINIC
|
|
; 9 10 ORIGINATING USER
|
|
; 10 11 PRIORITY
|
|
; 11 12 REQUESTED BY
|
|
; 12 13 PROVIDER
|
|
; 22 16 DESIRED DATE OF APPT
|
|
; 23 17 CURRENT STATUS
|
|
; 25 18 COMMENTS
|
|
; 27 20 NEW ENROLLE
|
|
;
|
|
N DIERR,SDWLDAX
|
|
I '$D(^SDWL(409.3,"B",SDWLDFN)) S SDWLRES=-1 Q ;- No Entry in Wait List file.
|
|
S SDWLDA="" F S SDWLDA=$O(^SDWL(409.3,"B",SDWLDFN,SDWLDA)) Q:SDWLDA<1 D
|
|
.S SDWLDAX="`"_SDWLDA
|
|
.D FIND^DIC(409.3,,".01;1;2;3;4;5;5.1;6;6.1;7;8;9;10;11;12;15;22;23;25","PS",.SDWLDAX)
|
|
I $G(DIERR) D CLEAN^DILF S SDWLRES=-1 Q
|
|
K SDWLOUT S SDWLOUT=$NA(^TMP("DILIST",$J))
|
|
Q
|
|
OUTPUT1(SDWLOUT,SDWLDFN) ;
|
|
;Brief Output - for Wait List.
|
|
; input:
|
|
; DFN = Patient
|
|
; Lookup uses Wait List data file (409.3) and returns the following data.
|
|
;
|
|
; output:
|
|
; SWDLRES = On/Not on Wait list^Number of IENs^IEN;IEN;IEN;IEN.....
|
|
; 1 0 ^ 2 ^1;2
|
|
;
|
|
S SDWLCNT=0,SDWLIEN=""
|
|
I '$D(^SDWL(409.3,"B",SDWLDFN)) S SDWLRES=$NA(^TMP("SDWLRP1",$J)),^TMP("SDWLRP1",$J,1)=-1
|
|
S SDWLDA="" F S SDWLDA=$O(^SDWL(409.3,"B",SDWLDFN,SDWLDA)) Q:SDWLDA<1 D
|
|
.I $P(^SDWL(409.3,SDWLDA,0),U,17)["C" Q
|
|
.S SDWLCNT=SDWLCNT+1
|
|
.S ^TMP("SDWLRP1",$J,SDWLCNT)=SDWLDA_"^"_$G(^SDWL(409.3,SDWLDA,0))
|
|
S SDWLOUT=$NA(^TMP("SDWLRP1",$J))
|
|
K SDWLDFN,SDWLDA,SDWLCNT,SDWLIEN
|
|
Q
|
|
OUTPUT3(SDWLOUT,SDWLDFN) ;Disposition Data
|
|
; input:
|
|
; DFN = Patient Internal ID
|
|
;
|
|
; output: Subscript 'DIS'
|
|
; Date Dsipositioned^Disposition by^Disposition
|
|
;
|
|
N SDWLRES,SDWLDFN,SDWLDA,DIERR
|
|
I '$D(^SDWL(409.3,"B",SDWLDFN)) S SDWLRES=-1 Q ;- No Entry in Wait List file.
|
|
S SDWLDA="" F S SDWLDA=$O(^SDWL(409.3,"B",SDWLDFN,SDWLDA)) Q:SDWLDA<1 D
|
|
.S SDWLDAX="`"_SDWLDA
|
|
.D FIND^DIC(409.3,,"19;20;21","PS",.SDWLDAX)
|
|
I $G(DIERR) D CLEAN^DILF S SDWLRES=-1 Q
|
|
K SDWLOUT S SDWLOUT="^TMP(""DILIST"","_$J_")",SDWLRES=1
|
|
Q
|
|
INPUT(SDWLRES,SDWLSTR) ;
|
|
; Input:
|
|
; SDWLSTR = location of data = ^TMP("SDWLG",$J,i,0)
|
|
; (R) = Required Field
|
|
; (O) = Optional
|
|
;
|
|
; .01 2 3 5 6
|
|
; DFN (R)^TYPE (R)^SPECIFIC TEAM (O)^SPECIFIC POSITION (O)^ORGINATING USER (R)^COMMENT (O)^CLINIC (O)^INTRA FLAG (O)^REJ FLAG (O)^MULTI TEAM FLAG (O)
|
|
; 1 2 3 4 5 6 7 8 9 10
|
|
;
|
|
; Output:
|
|
; SDWLRES = 0 Failed
|
|
; SDWLRES = 1^IEN Saved to ^SDWL(409.3,IEN,0)
|
|
;
|
|
N DIERR,%H,SDWLF,SDWLFLD,SDWLFLG,SDWLI,SDWLIN,SDWLMSG,SDWLRNED,SDWLTP,SDWLVAL,SDWLX,SDWLY,X,Y
|
|
K ^TMP("SDWLIN",$J),^TMP("SDWLOUT",$J),^TMP("DIERR",$J)
|
|
I '$G(SDWLSTR) S SDWLRES="-1^Data String Missing" Q
|
|
D NEW
|
|
D FDA I SDWLRES<0 D DEL Q
|
|
;D VAL I SDWLRES<0 D DEL Q
|
|
D SET I SDWLRES<0 D DEL Q
|
|
D CLEAN^DILF K ^TMP("SDWLIN",$J),^TMP("SDWLOUT",$J)
|
|
K SDWLDUZ,SDWLDFN,SDWLDA,Y
|
|
Q
|
|
NEW ;Get IEN from ^SDWL(409.3,IEN,0).
|
|
N DA,DIC,DIE,DIK,DR,SDREJ,SDINTRA,SDMULTI
|
|
I $P(SDWLSTR,U,4) D
|
|
.S SDWLTP=+$P(SDWLSTR,U,4)
|
|
.S SDWLIN=$P($G(^SCTM(404.51,+$P(^SCTM(404.57,SDWLTP,0),U,2),0)),U,7)
|
|
I $P(SDWLSTR,U,3) D
|
|
.S SDWLIN=$P($G(^SCTM(404.51,+$P(SDWLSTR,U,3),0)),U,7)
|
|
S SDWLDFN=+$P(SDWLSTR,U,1)
|
|
S SDREJ=$P(SDWLSTR,U,9),SDINTRA=$P(SDWLSTR,U,8),SDMULTI=$P(SDWLSTR,U,10)
|
|
;identify INTRA-transfer
|
|
;- last team assignment
|
|
S DIC(0)="LX",X=$P(SDWLSTR,U,1),DIC="^SDWL(409.3," D FILE^DICN I Y<0 S SDWLRES="-1^IEN failed" Q
|
|
S SDWLDFN=$P(Y,U,2),SDWLDA=+Y,SDWLDUZ=$P(SDWLSTR,U,9)
|
|
S DIE="^SDWL(409.3,",DA=SDWLDA
|
|
S DR="1///^S X=DT" D ^DIE
|
|
S DR="2////^S X=SDWLIN;32////^S X=SDREJ;34////^S X=SDINTRA;38////^S X=SDMULTI" D ^DIE
|
|
S DR="23///^S X=""O""",DIE="^SDWL(409.3," D ^DIE
|
|
;
|
|
;DETERMINE ENROLLEE STATUS
|
|
;
|
|
;SDWLE=1 = NEW ENROLLEE
|
|
;SDWLE=2 = ESTABLISHED
|
|
;SDWLE=3 = PRIOR ENROLLEE
|
|
;SDWLE=4 = UNDETERMINED
|
|
;
|
|
S SDWLDE=+$H,SDWLE=0,(SDWLEE,SDWLRNED,SDWLDB)=0 D SB1
|
|
G SB0:SDWLE=2
|
|
S SDWLRNE=$$ENROLL^EASWTAPI(SDWLDFN) G SB0:$P(SDWLRNE,U,4)="A" S SDWLRNED=$P(SDWLRNE,U,3)
|
|
I SDWLRNED S X=SDWLRNED D H^%DTC S SDWLDS=%H S SDWLDE=+$H,SDWLDET=SDWLDE-SDWLDS,SDWLDB=2 I SDWLDET<366 S SDWLE=1
|
|
I $D(SDWLDET),SDWLDET>365 S SDWLE=3
|
|
I 'SDWLRNE S SDWLE=4
|
|
SB0 I $D(SDWLRNE),$P(SDWLRNE,U,4)="A" D
|
|
.I 'SDWLRNE,SDWLEE>730!(SDWLEE=730) S SDWLE=4 Q
|
|
.I 'SDWLEE S SDWLE=4 Q
|
|
S SDWLRNE=$S(SDWLE=1:"N",SDWLE=2:"E",SDWLE=3:"P",SDWLE=4:"U",1:"U")
|
|
;-Code here for filling in 409.3
|
|
S DR="27////^S X=SDWLRNE",DIE="^SDWL(409.3,",DA=SDWLDA D ^DIE
|
|
S DR="9////^S X=DUZ" D ^DIE
|
|
S DR="27.1////^S X=$S($G(SDWLRNED):SDWLRNED,$G(SDWLD):SDWLD,1:"""")" D ^DIE
|
|
S DR="27.2////^S X=SDWLDB" D ^DIE
|
|
K SDWLRNE,SDWLD,SDWLDE,SDWLEE,SDWLDET,DIC,DIR,DR,DIE,SDWLDS,SDWLE
|
|
Q
|
|
SB1 I '$D(^DGCN(391.91,"B",SDWLDFN)) N SDWLDB S SDWLE=3 Q
|
|
S SDWLX="" F S SDWLX=$O(^DGCN(391.91,"B",SDWLDFN,SDWLX)) Q:SDWLX="" D
|
|
.S SDWLY=$G(^DGCN(391.91,SDWLX,0)) D
|
|
..;CHECK FOR TREATING FACILITY
|
|
..I $$TF^XUAF4(+$P(SDWLY,U,2)) D
|
|
...;SORT FOR LAST TREATMENT DATE
|
|
...S SDWLD=$P(SDWLY,U,3) I SDWLD S SDWLDTF(9999999-SDWLD)=SDWLX
|
|
I '$D(SDWLDTF) Q
|
|
S SDWLDTF=$O(SDWLDTF(0)) I SDWLDTF S (SDWLD,X)=9999999-SDWLDTF D H^%DTC S SDWLEE=SDWLDE-%H,SDWLDB=1 I SDWLEE<730 S SDWLE=2
|
|
I $D(SDWLEE),SDWLEE>730!(SDWLEE=730) S SDWLE=3
|
|
K SDWLDTF
|
|
Q
|
|
FDA ;Get data from SDWLSTR string and set FDA.
|
|
S SDWLF=409.3
|
|
S SDWLVAL="" F SDWLI=2:1:7 S SDWLVAL=$P(SDWLSTR,"^",SDWLI) D
|
|
.S SDWLFLD=SDWLI D
|
|
..S SDWLFLD=$S(SDWLFLD=2:4,SDWLFLD=3:5,SDWLFLD=4:6,SDWLFLD=5:9,SDWLFLD=7:15,1:25)
|
|
.S SDWLFLG="F",SDWLIEN=$$IENS^DILF(SDWLDA) ;,SDWLVAL=$$EXTERNAL^DILFD(SDWLF,SDWLFLD,,SDWLVAL,"SDWLMSG")
|
|
.I $D(SDWLMSG) M SDWLRES=SDWLMSG S SDWLRES=-1 Q
|
|
.D FDA^DILF(SDWLF,SDWLIEN,SDWLFLD,"",SDWLVAL,"^TMP(""SDWLIN"",$J)")
|
|
.S SDWLRES=1 M SDWLRES("SDWLIN")=^TMP("SDWLIN",$J)
|
|
Q
|
|
VAL ;Validate fields
|
|
N DIERR
|
|
D VALS^DIE(,"^TMP(""SDWLIN"",$J)","^TMP(""SDWLOUT"",$J)","SDWLMSG")
|
|
I $G(SDWLMSG("DIERR")) S SDWLRES=-1 Q
|
|
M SDWLRES("SDWLOUT")=^TMP("SDWLOUT",$J)
|
|
Q
|
|
SET ;Input data to file ^SDWL(409.3,IEN,0).
|
|
D UPDATE^DIE(,"^TMP(""SDWLIN"",$J)","SDWLMSG")
|
|
I $G(SDWLMSG("DIERR")) S SDWLRES=-1 Q
|
|
S SDWLRES=1_"^"_$G(SDWLDA)
|
|
Q
|
|
DEL S DA=SDWLDA,DIK="^SDWL(409.3," D ^DIK
|
|
S SDWLRES="-1^Entry "_SDWLDA_" Deleted"
|
|
Q
|
|
INPUTDP(SDWLRES,SDWLSTR) ;Set disposition in Wait List Patient file
|
|
;
|
|
; Input:
|
|
;
|
|
; SDWLSTR=Patient DFN^Disposition^User DUZ^Wait List IEN
|
|
;
|
|
; Ouput:
|
|
;
|
|
; SDWLRES=-1 Failed
|
|
; SDWKRES=1^IEN for Wait List File (409.3)
|
|
;
|
|
N SDWLDFN,SDWLDISP,SDWLDUZ,SDWLDA,SDWLDDT
|
|
I '$G(SDWLSTR) S SDWLRES="-1^Data String Missing" Q
|
|
I '$G(^SDWL(409.3,SDWLDA,0)) S SDWLRES="-1^Missing Patient IEN" Q
|
|
I '$D(^SDWL(409.3,"B",SDWLDFN)) S SDWLRES="-1^Missing Wait List data file" Q
|
|
D FDA1 I SDWLRES<0 D DEL1 Q
|
|
D VAL1 I SDWLRES<0 D DEL1 Q
|
|
D SET1 I SDWLRES<0 D DEL1 Q
|
|
D CLEAN^DILF K ^TMP("SDWLIN",$J),^TMP("SDWLOUT",$J)
|
|
Q
|
|
FDA1 ;
|
|
S SDWLDFN=$P(SDWLSTR,U,1),SDWLDISP=$P(SDWLSTR,U,2),SDWLDUZ=$P(SDWLSTR,U,3),SDWLDA=$P(SDWLSTR,U,4),SDWLDDT=DT
|
|
S SDWLIEN=$$IENS^DILF(SDWLDA)
|
|
F SDWLI=1:1:4 S SDWLVAL=$S(SDWLI=1:SDWLDISP,SDWLI=2:SDWLDUZ,SDWLI=3:SDWLDDT,SDWLI=4:"C"),SDWLFLD=$S(SDWLI=1:21,SDWLI=2:20,SDWLI=3:19,SDWLI=4:23) D
|
|
.S SDWLVAL=$$EXTERNAL^DILFD(SDWLF,SDWLFLD,,SDWLVAL,"SDWLMSG")
|
|
.I $D(SDWLMSG) M SDWLRES=SDWLMSG S SDWLRES=-1 Q
|
|
.D FDA^DILF(SDWLF,SDWLIEN,SDWLFLD,"",SDWLVAL,"^TMP(""SDWLIN"",$J)")
|
|
.S SDWLRES=1 M SDWLRES("SDWLIN")=^TMP("SDWLIN",$J)
|
|
Q
|
|
VAL1 ;
|
|
N DIERR
|
|
D VALS^DIE(,"^TMP(""SDWLIN"",$J)","^TMP(""SDWLOUT"",$J)","SDWLMSG")
|
|
I $G(SDWLMSG("DIERR")) S SDWLRES=-1 Q
|
|
M SDWLRES("SDWLOUT")=^TMP("SDWLOUT",$J)
|
|
Q
|
|
SET1 ;
|
|
D UPDATE^DIE(,"^TMP(""SDWLOUT"",$J)","SDWLMSG")
|
|
I $G(SDWLMSG("DIERR")) S SDWLRES=-1 Q
|
|
S SDWLRES=1
|
|
Q
|
|
DEL1 ;
|
|
S DA(1)=SDWLDA,DIK="^SDWL("_DA(1)_",""DIS""," F DA=19,20,21,23 D ^DIK
|
|
S SDWLRES="-1^"_"Disposition Nodes Deleted."
|
|
Q
|