Changeset 636 for FOIAVistA/tag/r/SCHEDULING-SD-SC/SDWLRP4.m

Timestamp:

Dec 4, 2009, 8:26:01 PM (14 years ago)

Author:

George Lilly

Message:

WorldVistAEHR overlayed on FOIAVistA

Location:

FOIAVistA/tag/r

Files:

• . (copied) (copied from FOIAVistA/trunk/r )
• SCHEDULING-SD-SC/SDWLRP4.m (modified) (2 diffs)

FOIAVistA/tag/r/SCHEDULING-SD-SC/SDWLRP4.m

@@ -1 +1 @@
 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
+ ;;5.3;scheduling;**263**;AUG 13 1993;Build 4
+ ;Modified from FOIA VISTA,
+ ;Copyright 2008 WorldVistA.  Licensed under the terms of the GNU
+ ;General Public License See attached copy of the License.
+ ;
+ ;This program is free software; you can redistribute it and/or modify
+ ;it under the terms of the GNU General Public License as published by
+ ;the Free Software Foundation; either version 2 of the License, or
+ ;(at your option) any later version.
+ ;
+ ;This program is distributed in the hope that it will be useful,
+ ;but WITHOUT ANY WARRANTY; without even the implied warranty of
+ ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ ;GNU General Public License for more details.
+ ;
+ ;You should have received a copy of the GNU General Public License along
+ ;with this program; if not, write to the Free Software Foundation, Inc.,
+ ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
  ;
 INPUT(SDWLRES,SDWLSTR) ;
@@ -83 +100 @@
  ;SDWLE=4 = UNDETERMINED
  ;
- S SDWLDE=+$H,SDWLE=0,(SDWLEE,SDWLRNED,SDWLDB)=0 D SB1
+ S SDWLDE=+$H,SDWLE=1,SDWLEE=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)
+ S SDWLRNE=$$ENROLL^EASWTAPI(SDWLDFN) 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")
+SB0 S SDWLRNE=$S(SDWLE=1:"N",SDWLE=2:"E",SDWLE=3:"P",SDWLE=4:"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
+SB1 I '$D(^DGCN(391.91,"B",SDWLDFN)) 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
+ .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
+ .I $D(SDWLEE),SDWLEE>730 S SDWLE=3
  Q
 FDA ;Get data from SDWLSTR string and set FDA.