SDWLFUL2 ;;IOFO BAY PINES/TEH - apply/RE-CAL ENROLLE STATUS;06/12/2002 ; 20 Aug 2002 2:10 PM
;;5.3;scheduling;**525**;AUG 13 1993;Build 47
;
;
;
;
;
;
Q
EN ;
I '$D(^XTMP("SDWLFULSTAT",$J,4)) W !,"You must run OPTION 4 before OPTION 5." Q
I $D(^XTMP("SDWLFULSTAT",$J,5)) W !,"You have already run this OPTION." Q
S DIR(0)="Y",DIR("B")="NO"
W !,"This Utility will APPLY the new ENROLLEE STATUS to your SD WAIT LIST file",!
S DIR("A")="Are you sure that you wish to continue"
D ^DIR I 'Y Q
N SDWLDA,SDWLTF,SDWLAPI,SDWLVS,SDWLC,SDWLTFD,SDWLAPID,SDWLVSD,SDWLODT
N SDWLCNT,SDWLIN
N SDWLX S SDWLCNT=0
S SDWLA=0 F S SDWLA=$O(^SDWL(409.39,SDWLA)) Q:SDWLA<1 D
.S SDWLX=$G(^SDWL(409.39,SDWLA,0)) I SDWLX="" Q
.W !,SDWLA S SDWLCNT=SDWLCNT+1
.S SDWLDA=$P(SDWLX,"^",10)
.S SDWLTF=$P(SDWLX,U,2),SDWLAPI=$P(SDWLX,U,3)
.S SDWLVS=$P(SDWLX,U,4),SDWLC=$P(SDWLX,U,5)
.S SDWLTFD=$P(SDWLX,U,6),SDWLAPID=$P(SDWLX,U,7)
.S SDWLVSD=$P(SDWLX,U,8),SDWLODT=$P(SDWLX,U,9),SDWLF=0
.S SDWLXX=$P(SDWLX,"^",2,4) I SDWLXX["E" S SDWLSET="E" D SET S SDWLF=1 Q
.I 'SDWLF,SDWLXX["P" S SDWLSET="P" D SET S SDWLF=1 Q
.I 'SDWLF,SDWLXX["N" S SDWLSET="N" D SET S SDWLF=1 Q
.I 'SDWLF S SDWLXX="U" S SDWLSET="U" D SET Q
END K DA,DIE,DR,I,SDWLA,SDWLF,X,DA,DIE,DR,SDWLA,SDWLF,SDWLXX,SDWLSET,DIR
W !,"All Records Processed."
S ^XTMP("SDWLFULSTAT",$J,5)=""
MESS ;SENT MESSAGE TO FORUM
N XMSUB,XMY,XMTEXT,XMDUZ,SDWLMSG,SDWLI,XQSUB,Y
S XMY("DERDERIAN.JOHN@DOMAIN.EXT")=""
S XMY("HOUTCHENS.THOMAS@DOMAIN.EXT")=""
S XMY("BROWN.BONNIE@DOMAIN.EXT")=""
S XMY("KROCHMAL.CHUCK@DOMAIN.EXT")=""
S XMY("TAPPER.BRIAN@DOMAIN.EXT")=""
S XMY("BENBOW.PHYLLIS@DOMAIN.EXT")=""
S XMY("LANDRIE.LARRY@DOMAIN.EXT")=""
S XMY("TOWSON.LINDA@DOMAIN.EXT")=""
S XMSUB="Patch SD*5.3*525 successful."
S XQSUB="Installation of SD*5.3*525."
S XMTEXT="SDWLMSG(",XMDUZ="POSTMASTER"
S SDWLIN=$$GET1^DIQ(4,DUZ(2)_",",.01,,)
S SDWLMSG(1,0)="Patch SD*5.3*525 successful installed at "_SDWLIN
S Y=DT D DD^%DT
S SDWLMSG(2,0)="At "_Y
S SDWLMSG(3,0)=SDWLCNT_" Records had the Enrollee Status field updated."
S SDWLMSG(4,0)="",SDWLMSG(0)=4
D ^XMD
Q
SET S DR="27////^S X=SDWLSET",DIE="^SDWL(409.3,",DA=SDWLDA D ^DIE
S DR="8.1////^S X=SDWLSET",DIE=409.39,DA=SDWLA D ^DIE
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDWLFUL2 2290 printed Dec 13, 2024@03:02:40 Page 2
SDWLFUL2 ;;IOFO BAY PINES/TEH - apply/RE-CAL ENROLLE STATUS;06/12/2002 ; 20 Aug 2002 2:10 PM
+1 ;;5.3;scheduling;**525**;AUG 13 1993;Build 47
+2 ;
+3 ;
+4 ;
+5 ;
+6 ;
+7 ;
+8 QUIT
EN ;
+1 IF '$DATA(^XTMP("SDWLFULSTAT",$JOB,4))
WRITE !,"You must run OPTION 4 before OPTION 5."
QUIT
+2 IF $DATA(^XTMP("SDWLFULSTAT",$JOB,5))
WRITE !,"You have already run this OPTION."
QUIT
+3 SET DIR(0)="Y"
SET DIR("B")="NO"
+4 WRITE !,"This Utility will APPLY the new ENROLLEE STATUS to your SD WAIT LIST file",!
+5 SET DIR("A")="Are you sure that you wish to continue"
+6 DO ^DIR
IF 'Y
QUIT
+7 NEW SDWLDA,SDWLTF,SDWLAPI,SDWLVS,SDWLC,SDWLTFD,SDWLAPID,SDWLVSD,SDWLODT
+8 NEW SDWLCNT,SDWLIN
+9 NEW SDWLX
SET SDWLCNT=0
+10 SET SDWLA=0
FOR
SET SDWLA=$ORDER(^SDWL(409.39,SDWLA))
if SDWLA<1
QUIT
Begin DoDot:1
+11 SET SDWLX=$GET(^SDWL(409.39,SDWLA,0))
IF SDWLX=""
QUIT
+12 WRITE !,SDWLA
SET SDWLCNT=SDWLCNT+1
+13 SET SDWLDA=$PIECE(SDWLX,"^",10)
+14 SET SDWLTF=$PIECE(SDWLX,U,2)
SET SDWLAPI=$PIECE(SDWLX,U,3)
+15 SET SDWLVS=$PIECE(SDWLX,U,4)
SET SDWLC=$PIECE(SDWLX,U,5)
+16 SET SDWLTFD=$PIECE(SDWLX,U,6)
SET SDWLAPID=$PIECE(SDWLX,U,7)
+17 SET SDWLVSD=$PIECE(SDWLX,U,8)
SET SDWLODT=$PIECE(SDWLX,U,9)
SET SDWLF=0
+18 SET SDWLXX=$PIECE(SDWLX,"^",2,4)
IF SDWLXX["E"
SET SDWLSET="E"
DO SET
SET SDWLF=1
QUIT
+19 IF 'SDWLF
IF SDWLXX["P"
SET SDWLSET="P"
DO SET
SET SDWLF=1
QUIT
+20 IF 'SDWLF
IF SDWLXX["N"
SET SDWLSET="N"
DO SET
SET SDWLF=1
QUIT
+21 IF 'SDWLF
SET SDWLXX="U"
SET SDWLSET="U"
DO SET
QUIT
End DoDot:1
END KILL DA,DIE,DR,I,SDWLA,SDWLF,X,DA,DIE,DR,SDWLA,SDWLF,SDWLXX,SDWLSET,DIR
+1 WRITE !,"All Records Processed."
+2 SET ^XTMP("SDWLFULSTAT",$JOB,5)=""
MESS ;SENT MESSAGE TO FORUM
+1 NEW XMSUB,XMY,XMTEXT,XMDUZ,SDWLMSG,SDWLI,XQSUB,Y
+2 SET XMY("DERDERIAN.JOHN@DOMAIN.EXT")=""
+3 SET XMY("HOUTCHENS.THOMAS@DOMAIN.EXT")=""
+4 SET XMY("BROWN.BONNIE@DOMAIN.EXT")=""
+5 SET XMY("KROCHMAL.CHUCK@DOMAIN.EXT")=""
+6 SET XMY("TAPPER.BRIAN@DOMAIN.EXT")=""
+7 SET XMY("BENBOW.PHYLLIS@DOMAIN.EXT")=""
+8 SET XMY("LANDRIE.LARRY@DOMAIN.EXT")=""
+9 SET XMY("TOWSON.LINDA@DOMAIN.EXT")=""
+10 SET XMSUB="Patch SD*5.3*525 successful."
+11 SET XQSUB="Installation of SD*5.3*525."
+12 SET XMTEXT="SDWLMSG("
SET XMDUZ="POSTMASTER"
+13 SET SDWLIN=$$GET1^DIQ(4,DUZ(2)_",",.01,,)
+14 SET SDWLMSG(1,0)="Patch SD*5.3*525 successful installed at "_SDWLIN
+15 SET Y=DT
DO DD^%DT
+16 SET SDWLMSG(2,0)="At "_Y
+17 SET SDWLMSG(3,0)=SDWLCNT_" Records had the Enrollee Status field updated."
+18 SET SDWLMSG(4,0)=""
SET SDWLMSG(0)=4
+19 DO ^XMD
+20 QUIT
SET SET DR="27////^S X=SDWLSET"
SET DIE="^SDWL(409.3,"
SET DA=SDWLDA
DO ^DIE
+1 SET DR="8.1////^S X=SDWLSET"
SET DIE=409.39
SET DA=SDWLA
DO ^DIE
+2 QUIT
