- 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 Mar 13, 2025@22:07:44 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
