| 1 | SDWLRP4 ;IOFO BAY PINES/TEH - WAITING LIST - MERGE RPC;06/28/2002 ; 26 Aug 2002 1:25 PM
|
|---|
| 2 | ;;5.3;scheduling;**263**;AUG 13 1993;Build 4
|
|---|
| 3 | ;Modified from FOIA VISTA,
|
|---|
| 4 | ;Copyright 2008 WorldVistA. Licensed under the terms of the GNU
|
|---|
| 5 | ;General Public License See attached copy of the License.
|
|---|
| 6 | ;
|
|---|
| 7 | ;This program is free software; you can redistribute it and/or modify
|
|---|
| 8 | ;it under the terms of the GNU General Public License as published by
|
|---|
| 9 | ;the Free Software Foundation; either version 2 of the License, or
|
|---|
| 10 | ;(at your option) any later version.
|
|---|
| 11 | ;
|
|---|
| 12 | ;This program is distributed in the hope that it will be useful,
|
|---|
| 13 | ;but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|---|
| 14 | ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|---|
| 15 | ;GNU General Public License for more details.
|
|---|
| 16 | ;
|
|---|
| 17 | ;You should have received a copy of the GNU General Public License along
|
|---|
| 18 | ;with this program; if not, write to the Free Software Foundation, Inc.,
|
|---|
| 19 | ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
|
|---|
| 20 | ;
|
|---|
| 21 | INPUT(SDWLRES,SDWLSTR) ;
|
|---|
| 22 | ;
|
|---|
| 23 | ;
|
|---|
| 24 | ; Input:
|
|---|
| 25 | ; SDWLSTR = location of data = ^TMP("SDWLG",$J,i,0)
|
|---|
| 26 | ; (R) = Required Field
|
|---|
| 27 | ; (O) = Optional
|
|---|
| 28 | ;
|
|---|
| 29 | ; .01 2 3 4 5 9 10 11 23 22
|
|---|
| 30 | ; SSN (R)^ORIGINATING DATE^INSTITUTION^TYPE (R)^^TYPE MOD^ORGINATING USER (R)^PRIORITY^REQUEST BY^CURRENT STATUS^DESIRED DATE
|
|---|
| 31 | ; 1 2 3 4 6/7/8/9 10 11 12 17 16
|
|---|
| 32 | ;
|
|---|
| 33 | ; Output:
|
|---|
| 34 | ; SDWLRES = -1^MESSAGE Failed
|
|---|
| 35 | ; SDWLRES = 1^IEN Saved to ^SDWL(409.3,IEN,0)
|
|---|
| 36 | ;
|
|---|
| 37 | ;
|
|---|
| 38 | K ^TMP("SDWLIN",$J),^TMP("SDWLOUT",$J),^TMP("DIERR",$J),D
|
|---|
| 39 | I '$G(SDWLSTR) S SDWLRES="-1^Data String Missing^Failed" Q
|
|---|
| 40 | I $P(SDWLSTR,U)="" S SDWLRES="-1^No SSN^Failed" Q
|
|---|
| 41 | I $P(SDWLSTR,U,3)="" S SDWLRES="-1^No Insitution^Failed" Q
|
|---|
| 42 | I $P(SDWLSTR,U,4)="" S SDWLRES="-1^No Type^Failed" Q
|
|---|
| 43 | 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
|
|---|
| 44 | I $P(SDWLSTR,U,11)'="",$$DCHK($P(SDWLSTR,U,11))<1 S SDWLRES="-1^Invalid Date^Failed" Q
|
|---|
| 45 | S $P(SDWLSTR,U)=$TR($P(SDWLSTR,U),"-","")
|
|---|
| 46 | D NEW
|
|---|
| 47 | I $P(SDWLRES,U,1)<0 Q
|
|---|
| 48 | D FDA I SDWLRES<0 D DEL Q
|
|---|
| 49 | D SET I SDWLRES<0 D DEL Q
|
|---|
| 50 | D CLEAN^DILF K ^TMP("SDWLIN",$J),^TMP("SDWLOUT",$J)
|
|---|
| 51 | Q
|
|---|
| 52 | NEW ;Get IEN from ^SDWL(409.3,IEN,0).
|
|---|
| 53 | N SDWLTP,SDWL6,SDWL6P,SDWL7,SDWL7P,SDWL8,SDWL8P,SDWL9,SDWL9P,SDWLMOD,SDWLTP,SDWLIN,SDWLDFN
|
|---|
| 54 | N SDWLPRI,SDWLODUZ,SDWLRBY
|
|---|
| 55 | S SDWLRES=""
|
|---|
| 56 | I $P(SDWLSTR,U,4) D
|
|---|
| 57 | .S SDWLTP=+$P(SDWLSTR,U,4),(SDWL6,SDWL7,SDWL8,SDWL9)="",SDWLMOD=0 D
|
|---|
| 58 | ..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
|
|---|
| 59 | ..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
|
|---|
| 60 | ..I SDWLTP=3 S SDWL8=$P(SDWLSTR,U,8),SDWL80="" F S SDWL80=$O(^DIC(40.7,"B",SDWL8,SDWL80)) Q:SDWL80="" D
|
|---|
| 61 | ...I $D(^SDWL(409.31,"B",SDWL80)) S SDWL8=$O(^SDWL(409.31,"B",SDWL80,0)),$P(SDWLSTR,U,8)=SDWL8,SDWLMOD=1
|
|---|
| 62 | ..I SDWLTP=4 S SDWL9=$P(SDWLSTR,U,9),SDWL90="" F SDWL90=$O(^SC("B",SDWL9,SDWL90)) Q:SDWL90="" D
|
|---|
| 63 | ...I $D(^SDWL(409.32,"B",SDWL90)) S SDWL9=$O(^SDWL(409.32,"B",SDWL90,0)),$P(SDWLSTR,U,9)=SDWL9,SDWLMOD=1
|
|---|
| 64 | I 'SDWLMOD S SDWLRES="-1^No Type Mod found^Failed" Q
|
|---|
| 65 | S SDWLIN=$P(SDWLSTR,U,3) I SDWLIN="" S SDWLRES="-1^No Institution^Failed" Q
|
|---|
| 66 | S SDWLIN=$O(^DIC(4,"B",SDWLIN,0)) I SDWLIN="" S SDWLRES="-1^Invalid Institution^Failed" Q
|
|---|
| 67 | 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
|
|---|
| 68 | S SDWLDFN=+Y
|
|---|
| 69 | I SDWLDFN="" S SDWLRES="-1^Invalid SSN^Failed" Q
|
|---|
| 70 | I $$DUP(SDWLDFN) S SDWLRES="-1^Duplicate^Failed" Q
|
|---|
| 71 | S SDWLPRI=$S($P(SDWLSTR,U,11)="":"A",1:"F")
|
|---|
| 72 | S SDWLODUZ=.5,SDWLRBY=2
|
|---|
| 73 | I SDWLTP=1!(SDWLTP=2) S SDWLPRI="A",SDWLRBY=""
|
|---|
| 74 | S SDWLSTRN=SDWLTP_"^"_SDWLPRI_"^"_SDWLODUZ_"^"_SDWLRBY_"^"_SDWL6_"^"_SDWL7_"^"_SDWL8_"^"_SDWL9
|
|---|
| 75 | S DIC(0)="LX",X=SDWLDFN,DIC="^SDWL(409.3," D FILE^DICN I Y<0 S SDWLRES="-1^IEN failed^Failed" Q
|
|---|
| 76 | S SDWLDFN=$P(Y,U,2),SDWLDA=+Y,SDWLDUZ=$P(SDWLSTR,U,9)
|
|---|
| 77 | S DIE="^SDWL(409.3,",DA=SDWLDA
|
|---|
| 78 | I SDWLPRI="F" D
|
|---|
| 79 | .S DR="22///"_$P(SDWLSTR,U,11) D ^DIE
|
|---|
| 80 | I SDWLPRI="A",SDWLTP=3!(SDWLTP=4) D
|
|---|
| 81 | .S DR="22///^S X=DT" D ^DIE
|
|---|
| 82 | S DR="1////^S X=DT" D ^DIE
|
|---|
| 83 | S DR="2////^S X=SDWLIN" D ^DIE
|
|---|
| 84 | S DR="23////^S X=""O""",DIE="^SDWL(409.3," D ^DIE K DIE,DR,DA
|
|---|
| 85 | ;
|
|---|
| 86 | ;SET DATE OF DEATH
|
|---|
| 87 | ;
|
|---|
| 88 | S X=$$GET1^DIQ(2,SDWLDFN_",",".351") I X'="" D
|
|---|
| 89 | .S DA=SDWLDA
|
|---|
| 90 | .S DR="19////^S X=DT",DIE="^SDWL(409.3," D ^DIE
|
|---|
| 91 | .S DR="20////^S X=DUZ" D ^DIE
|
|---|
| 92 | .S DR="23////^S X=""C""" D ^DIE
|
|---|
| 93 | .S DR="21////^S X=""D""" D ^DIE K DIE,DR,DA
|
|---|
| 94 | ;
|
|---|
| 95 | ;DETERMINE ENROLLEE STATUS
|
|---|
| 96 | ;
|
|---|
| 97 | ;SDWLE=1 = NEW ENROLLEE
|
|---|
| 98 | ;SDWLE=2 = ESTABLISHED
|
|---|
| 99 | ;SDWLE=3 = PRIOR ENROLLEE
|
|---|
| 100 | ;SDWLE=4 = UNDETERMINED
|
|---|
| 101 | ;
|
|---|
| 102 | S SDWLDE=+$H,SDWLE=1,SDWLEE=0 D SB1
|
|---|
| 103 | G SB0:SDWLE=2
|
|---|
| 104 | S SDWLRNE=$$ENROLL^EASWTAPI(SDWLDFN) S SDWLRNED=$P(SDWLRNE,U,3)
|
|---|
| 105 | I SDWLRNED S X=SDWLRNED D H^%DTC S SDWLDS=%H S SDWLDE=+$H,SDWLDET=SDWLDE-SDWLDS I SDWLDET<366 S SDWLE=1
|
|---|
| 106 | I $D(SDWLDET),SDWLDET>365 S SDWLE=3
|
|---|
| 107 | I 'SDWLRNE S SDWLE=4
|
|---|
| 108 | SB0 S SDWLRNE=$S(SDWLE=1:"N",SDWLE=2:"E",SDWLE=3:"P",SDWLE=4:"U")
|
|---|
| 109 | ;-Code here for filling in 409.3
|
|---|
| 110 | S DR="27////^S X=SDWLRNE",DIE="^SDWL(409.3,",DA=SDWLDA D ^DIE
|
|---|
| 111 | S DR="9////^S X=DUZ" D ^DIE K DIE,DA,DR,%H
|
|---|
| 112 | Q
|
|---|
| 113 | SB1 I '$D(^DGCN(391.91,"B",SDWLDFN)) S SDWLE=3 Q
|
|---|
| 114 | S SDWLX="" F S SDWLX=$O(^DGCN(391.91,"B",SDWLDFN,SDWLX)) Q:SDWLX="" D
|
|---|
| 115 | .S SDWLY=$G(^DGCN(391.91,SDWLX,0)),SDWLD=$P(^(0),U,3) I SDWLD S X=SDWLD D H^%DTC S SDWLEE=SDWLDE-%H I SDWLEE<730 S SDWLE=2
|
|---|
| 116 | .I $D(SDWLEE),SDWLEE>730 S SDWLE=3
|
|---|
| 117 | Q
|
|---|
| 118 | FDA ;Get data from SDWLSTR string and set FDA.
|
|---|
| 119 | S SDWLF=409.3
|
|---|
| 120 | S SDWLVAL="" F SDWLI=1,2,3,4,5,6,7,8 S SDWLVAL=$P(SDWLSTRN,"^",SDWLI) D
|
|---|
| 121 | .S SDWLFLD=SDWLI D
|
|---|
| 122 | ..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)
|
|---|
| 123 | .S SDWLFLG="F",SDWLIEN=$$IENS^DILF(SDWLDA) ;,SDWLVAL=$$EXTERNAL^DILFD(SDWLF,SDWLFLD,,SDWLVAL,"SDWLMSG")
|
|---|
| 124 | .I $D(SDWLMSG) M SDWLRES=SDWLMSG S SDWLRES=-1 Q
|
|---|
| 125 | .D FDA^DILF(SDWLF,SDWLIEN,SDWLFLD,"",SDWLVAL,"^TMP(""SDWLIN"",$J)")
|
|---|
| 126 | .S SDWLRES=1 M SDWLRES("SDWLIN")=^TMP("SDWLIN",$J)
|
|---|
| 127 | Q
|
|---|
| 128 | VAL ;Validate fields
|
|---|
| 129 | ;
|
|---|
| 130 | D VALS^DIE(,"^TMP(""SDWLIN"",$J)","^TMP(""SDWLOUT"",$J)","SDWLMSG")
|
|---|
| 131 | I $G(SDWLMSG("DIERR")) S SDWLRES=-1 Q
|
|---|
| 132 | M SDWLRES("SDWLOUT")=^TMP("SDWLOUT",$J)
|
|---|
| 133 | Q
|
|---|
| 134 | ;
|
|---|
| 135 | SET ;Input data to file ^SDWL(409.3,IEN,0)
|
|---|
| 136 | D UPDATE^DIE(,"^TMP(""SDWLIN"",$J)","SDWLMSG")
|
|---|
| 137 | I $G(SDWLMSG("DIERR")) S SDWLRES=-1 Q
|
|---|
| 138 | K DIC,DA
|
|---|
| 139 | S SDWLRES=1_"^"_$G(SDWLDA)
|
|---|
| 140 | Q
|
|---|
| 141 | DEL S DA=SDWLDA,DIK="^SDWL(409.3," D ^DIK K DIK,DA
|
|---|
| 142 | S SDWLRES="-1^Entry "_SDWLDA_" Deleted"
|
|---|
| 143 | Q
|
|---|
| 144 | DUP(IEN) ;Duplicate Check
|
|---|
| 145 | ;if institution, wait list type, and wait list modifier are the same it's a duplicate
|
|---|
| 146 | ;SDWLV1 : IEN in 409.3
|
|---|
| 147 | ;SDWLV2 : Zero node of 409.3
|
|---|
| 148 | ;SDWLV3 : Wait List Type Modifier value passed in
|
|---|
| 149 | ;SDWLV4 : Wait List Type Modifier value in current record
|
|---|
| 150 | ;SDWLIN : Institution value passed in checked against piece 3 of current record
|
|---|
| 151 | ;SDWLSTR : Incoming value string
|
|---|
| 152 | ; Wait List Type piece 4 of SDWLSTR (incoming value) checked against piece 5
|
|---|
| 153 | ; of SDWLV2 (zero node of current record
|
|---|
| 154 | N SDWLV1,SDWLV2,SDWLV3,SDWLV4,SDWLV5
|
|---|
| 155 | S (SDWLV1,SDWLV5)=0
|
|---|
| 156 | F S SDWLV1=$O(^SDWL(409.3,"B",IEN,SDWLV1)) Q:('SDWLV1!SDWLV5) D
|
|---|
| 157 | . S SDWLV2=$G(^SDWL(409.3,SDWLV1,0)) Q:SDWLV2=""
|
|---|
| 158 | . 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)
|
|---|
| 159 | . 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)
|
|---|
| 160 | . I $P(SDWLV2,U,3)=SDWLIN,$P(SDWLSTR,U,4)=$P(SDWLV2,U,5),SDWLV3=SDWLV4 S SDWLV5=1 Q
|
|---|
| 161 | Q SDWLV5
|
|---|
| 162 | DCHK(VALID) ;Check for valid DESIRED DATE
|
|---|
| 163 | N X
|
|---|
| 164 | S X=VALID,%DT="X" D ^%DT
|
|---|
| 165 | Q Y
|
|---|
