SDWLFUL2.m

SDWLFUL2 ;;IOFO BAY PINES/TEH - apply/RE-CAL ENROLLE STATUS;06/12/2002 ; 20 Aug 2002 2:10 PM

 ;;5.3;scheduling;**525,1015**;AUG 13 1993;Build 21

 ;

 ;

 ;

 ;

 ;

 ;

 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@FORUM.VA.GOV")=""

 S XMY("HOUTCHENS.THOMAS@FORUM.VA.GOV")=""

 S XMY("BROWN.BONNIE@FORUM.VA.GOV")=""

 S XMY("KROCHMAL.CHUCK@FORUM.VA.GOV")=""

 S XMY("TAPPER.BRIAN@FORUM.VA.GOV")=""

 S XMY("BENBOW.PHYLLIS@FORUM.VA.GOV")=""

 S XMY("LANDRIE.LARRY@FORUM.VA.GOV")=""

 S XMY("TOWSON.LINDA@FORUM.VA.GOV")=""

 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

SDWLFUL2  ;;IOFO BAY PINES/TEH - apply/RE-CAL ENROLLE STATUS;06/12/2002 ; 20 Aug 2002 2:10 PM

 +1       ;;5.3;scheduling;**525,1015**;AUG 13 1993;Build 21

 +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@FORUM.VA.GOV")=""

 +3        SET XMY("HOUTCHENS.THOMAS@FORUM.VA.GOV")=""

 +4        SET XMY("BROWN.BONNIE@FORUM.VA.GOV")=""

 +5        SET XMY("KROCHMAL.CHUCK@FORUM.VA.GOV")=""

 +6        SET XMY("TAPPER.BRIAN@FORUM.VA.GOV")=""

 +7        SET XMY("BENBOW.PHYLLIS@FORUM.VA.GOV")=""

 +8        SET XMY("LANDRIE.LARRY@FORUM.VA.GOV")=""

 +9        SET XMY("TOWSON.LINDA@FORUM.VA.GOV")=""

 +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