SDWLRP4 ;IOFO BAY PINES/TEH - WAITING LIST - MERGE RPC;06/28/2002 ; 26 Aug 2002  1:25 PM
 ;;5.3;scheduling;**263,485,497**;AUG 13 1993;Build 3
 ;
INPUT(SDWLRES,SDWLSTR) ;
 ;
 ;     
 ; Input:
 ;   SDWLSTR = location of data = ^TMP("SDWLG",$J,i,0)
 ;   (R) = Required Field
 ;   (O) = Optional
 ;   
 ;   .01                2             3        4          5           9               10        11           23       22
 ;  SSN (R)^ORIGINATING DATE^INSTITUTION^TYPE (R)^^TYPE MOD^ORGINATING USER (R)^PRIORITY^REQUEST BY^CURRENT STATUS^DESIRED DATE
 ;    1              2                3        4        6/7/8/9       10               11       12              17    16   
 ;
 ;  Output:
 ;               SDWLRES  =  -1^MESSAGE      Failed
 ;               SDWLRES  =  1^IEN  Saved to ^SDWL(409.3,IEN,0)            
 ;
 ;
 K ^TMP("SDWLIN",$J),^TMP("SDWLOUT",$J),^TMP("DIERR",$J),D
 I '$G(SDWLSTR) S SDWLRES="-1^Data String Missing^Failed" Q
 I $P(SDWLSTR,U)="" S SDWLRES="-1^No SSN^Failed" Q
 I $P(SDWLSTR,U,3)="" S SDWLRES="-1^No Insitution^Failed" Q
 I $P(SDWLSTR,U,4)="" S SDWLRES="-1^No Type^Failed" Q
 I $P(SDWLSTR,U,6)="",$P(SDWLSTR,U,7)="",$P(SDWLSTR,U,8)="",$P(SDWLSTR,U,9)="" S SDWLRES="-1^No Type Modifier^Failed" Q
 I $P(SDWLSTR,U,11)'="",$$DCHK($P(SDWLSTR,U,11))<1 S SDWLRES="-1^Invalid Date^Failed" Q
 S $P(SDWLSTR,U)=$TR($P(SDWLSTR,U),"-","")
 D NEW
 I $P(SDWLRES,U,1)<0 Q
 D FDA I SDWLRES<0 D DEL Q
 D SET I SDWLRES<0 D DEL Q
 D CLEAN^DILF K ^TMP("SDWLIN",$J),^TMP("SDWLOUT",$J)
 Q
NEW ;Get IEN from ^SDWL(409.3,IEN,0).
 N SDWLTP,SDWL6,SDWL6P,SDWL7,SDWL7P,SDWL8,SDWL8P,SDWL9,SDWL9P,SDWLMOD,SDWLTP,SDWLIN,SDWLDFN
 N SDWLPRI,SDWLODUZ,SDWLRBY
 S SDWLRES=""
 I $P(SDWLSTR,U,4) D
 .S SDWLTP=+$P(SDWLSTR,U,4),(SDWL6,SDWL7,SDWL8,SDWL9)="",SDWLMOD=0 D
 ..I SDWLTP=1 S SDWL6=$P(SDWLSTR,U,6),SDWL6=$O(^SCTM(404.51,"B",SDWL6,"")) I SDWL6'="" S SDWL6P=$O(^SCTM(404.51,"B",SDWL6,0)),SDWLMOD=1
 ..I SDWLTP=2 S SDWL7=$P(SDWLSTR,U,7),SDWL7=$O(^SCTM(404.57,"B",SDWL7,"")) I SDWL7'="" S SDWL7P=$O(^SCTM(404.57,"B",SDWL7,0)),SDWLMOD=1
 ..I SDWLTP=3 S SDWL8=$P(SDWLSTR,U,8),SDWL80="" F  S SDWL80=$O(^DIC(40.7,"B",SDWL8,SDWL80))  Q:SDWL80=""  D
 ...I $D(^SDWL(409.31,"B",SDWL80)) S SDWL8=$O(^SDWL(409.31,"B",SDWL80,0)),$P(SDWLSTR,U,8)=SDWL8,SDWLMOD=1
 ..I SDWLTP=4 S SDWL9=$P(SDWLSTR,U,9),SDWL90="" F SDWL90=$O(^SC("B",SDWL9,SDWL90)) Q:SDWL90=""  D
 ...I $D(^SDWL(409.32,"B",SDWL90)) S SDWL9=$O(^SDWL(409.32,"B",SDWL90,0)),$P(SDWLSTR,U,9)=SDWL9,SDWLMOD=1
 I 'SDWLMOD S SDWLRES="-1^No Type Mod found^Failed" Q
 S SDWLIN=$P(SDWLSTR,U,3) I SDWLIN="" S SDWLRES="-1^No Institution^Failed" Q
 S SDWLIN=$O(^DIC(4,"B",SDWLIN,0)) I SDWLIN="" S SDWLRES="-1^Invalid Institution^Failed" Q
 S SDWLDFN=$P(SDWLSTR,U,1) S D="SSN",DIC(0)="MNZ",X=SDWLDFN,D="SSN",DIC=2 D IX^DIC I Y<0 S SDWLRES="-1^SSN failed" Q
 S SDWLDFN=+Y
 I SDWLDFN="" S SDWLRES="-1^Invalid SSN^Failed" Q
 I $$DUP(SDWLDFN) S SDWLRES="-1^Duplicate^Failed" Q
 S SDWLPRI=$S($P(SDWLSTR,U,11)="":"A",1:"F")
 S SDWLODUZ=.5,SDWLRBY=2
 I SDWLTP=1!(SDWLTP=2) S SDWLPRI="A",SDWLRBY=""
 S SDWLSTRN=SDWLTP_"^"_SDWLPRI_"^"_SDWLODUZ_"^"_SDWLRBY_"^"_SDWL6_"^"_SDWL7_"^"_SDWL8_"^"_SDWL9
 S DIC(0)="LX",X=SDWLDFN,DIC="^SDWL(409.3," D FILE^DICN I Y<0 S SDWLRES="-1^IEN failed^Failed" Q
 S SDWLDFN=$P(Y,U,2),SDWLDA=+Y,SDWLDUZ=$P(SDWLSTR,U,9)
 S DIE="^SDWL(409.3,",DA=SDWLDA
 I SDWLPRI="F" D
 .S DR="22///"_$P(SDWLSTR,U,11) D ^DIE
 I SDWLPRI="A",SDWLTP=3!(SDWLTP=4) D
 .S DR="22///^S X=DT" D ^DIE
 S DR="1////^S X=DT" D ^DIE
 S DR="2////^S X=SDWLIN" D ^DIE
 S DR="23////^S X=""O""",DIE="^SDWL(409.3," D ^DIE K DIE,DR,DA
 ;
 ;SET DATE OF DEATH
 ;
 S X=$$GET1^DIQ(2,SDWLDFN_",",".351") I X'="" D
 .S DA=SDWLDA
 .S DR="19////^S X=DT",DIE="^SDWL(409.3," D ^DIE
 .S DR="20////^S X=DUZ" D ^DIE
 .S DR="23////^S X=""C""" D ^DIE
 .S DR="21////^S X=""D""" D ^DIE K DIE,DR,DA
 ;
 ;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 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 'SDWLEE.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="27.1////^S X=$S($G(SDWLRNED):SDWLRNED,$G(SDWLD):SDWLD,1:"""")" D ^DIE
 S DR="27.2////^S X=SDWLDB" D ^DIE
 S DR="9////^S X=DUZ" D ^DIE K DIE,DA,DR,%H
 K SDWLRNE,SDWLD,SDWLDE,SDWLEE,SDWLDET,DIC,DIR,DR,DIE,SDWLDS,SDWLE,SDWLRNED
 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 S SDWLE=3
 K SDWLDTF
 Q
FDA ;Get data from SDWLSTR string and set FDA.
 S SDWLF=409.3
 S SDWLVAL="" F SDWLI=1,2,3,4,5,6,7,8 S SDWLVAL=$P(SDWLSTRN,"^",SDWLI) D
 .S SDWLFLD=SDWLI D
 ..S SDWLFLD=$S(SDWLFLD=1:4,SDWLFLD=2:10,SDWLFLD=3:9,SDWLFLD=4:11,SDWLFLD=5:5,SDWLFLD=6:6,SDWLFLD=7:7,SDWLFLD=8:8)
 .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
 ;
 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
 K DIC,DA
 S SDWLRES=1_"^"_$G(SDWLDA)
 Q
DEL S DA=SDWLDA,DIK="^SDWL(409.3," D ^DIK K DIK,DA
 S SDWLRES="-1^Entry "_SDWLDA_" Deleted"
 Q
DUP(IEN) ;Duplicate Check
 ;if institution, wait list type, and wait list modifier are the same it's a duplicate
 ;SDWLV1  :  IEN in 409.3
 ;SDWLV2  :  Zero node of 409.3
 ;SDWLV3  :  Wait List Type Modifier value passed in
 ;SDWLV4  :  Wait List Type Modifier value in current record
 ;SDWLIN  :  Institution value passed in checked against piece 3 of current record
 ;SDWLSTR :  Incoming value string
 ;           Wait List Type piece 4 of SDWLSTR (incoming value) checked against piece 5
 ;           of SDWLV2 (zero node of current record
 N SDWLV1,SDWLV2,SDWLV3,SDWLV4,SDWLV5
 S (SDWLV1,SDWLV5)=0
 F  S SDWLV1=$O(^SDWL(409.3,"B",IEN,SDWLV1)) Q:('SDWLV1!SDWLV5)  D
 . S SDWLV2=$G(^SDWL(409.3,SDWLV1,0)) Q:SDWLV2=""
 . S SDWLV3=$S($P(SDWLSTR,U,4)=1:SDWL6,$P(SDWLSTR,U,4)=2:SDWL7,$P(SDWLSTR,U,4)=3:SDWL8,$P(SDWLSTR,U,4)=4:SDWL9,1:0)
 . S SDWLV4=$S($P(SDWLV2,U,5)=1:$P(SDWLV2,U,6),$P(SDWLV2,U,5)=2:$P(SDWLV2,U,7),$P(SDWLV2,U,5)=3:$P(SDWLV2,U,8),$P(SDWLV2,U,5)=4:$P(SDWLV2,U,9),1:0)
 . I $P(SDWLV2,U,3)=SDWLIN,$P(SDWLSTR,U,4)=$P(SDWLV2,U,5),SDWLV3=SDWLV4 S SDWLV5=1 Q
 Q SDWLV5
DCHK(VALID) ;Check for valid DESIRED DATE
 N X
 S X=VALID,%DT="X" D ^%DT
 Q Y