| [613] | 1 | DGYPPOST ;ALB/MLI - Clean-up cross-reference on Annual Means Test file ; 20 JUNE 95
|
|---|
| 2 | ;;5.3;Registration;**68**;Aug 13, 1993
|
|---|
| 3 | ;
|
|---|
| 4 | ; This routine will run through entries in the AD cross-reference on
|
|---|
| 5 | ; the ANNUAL MEANS TEST file (#408.31) to ensure they are accurate.
|
|---|
| 6 | ;
|
|---|
| 7 | EN ; entry point
|
|---|
| 8 | N I,X
|
|---|
| 9 | W !! F I=1:1 S X=$P($T(TEXT+I),";;",2) Q:X="QUIT" W !,X
|
|---|
| 10 | S ZTRTN="DQ^DGYPPOST",ZTIO="",ZTDESC="MT X-REF CLEAN-UP"
|
|---|
| 11 | D ^%ZTLOAD
|
|---|
| 12 | I $D(ZTSK) W !,"Task queued: ",ZTSK
|
|---|
| 13 | E W "...RUNNING IMMEDIATELY" D DQ W !,"Done!"
|
|---|
| 14 | K ZTDESC,ZTIO,ZTRTN,ZTSK
|
|---|
| 15 | Q
|
|---|
| 16 | ;
|
|---|
| 17 | ;
|
|---|
| 18 | DQ ; call to begin processing
|
|---|
| 19 | N DGSTART,COUNT
|
|---|
| 20 | S DGSTART=$$NOW^XLFDT()
|
|---|
| 21 | D ADCLN,MAIL
|
|---|
| 22 | Q
|
|---|
| 23 | ;
|
|---|
| 24 | ;
|
|---|
| 25 | ADCLN N I,J,K,X
|
|---|
| 26 | S COUNT=0,COUNT(1)=0
|
|---|
| 27 | I '$D(ZTQUEUED) W !,">>Checking AD cross-reference and killing erroneous entries..."
|
|---|
| 28 | S I=0 F S I=$O(^DGMT(408.31,"AD",I)) Q:'I D
|
|---|
| 29 | . F J=0:0 S J=$O(^DGMT(408.31,"AD",I,J)) Q:'J D
|
|---|
| 30 | . . F K=0:0 S K=$O(^DGMT(408.31,"AD",I,J,K)) Q:'K S DA=+$O(^(K,0)) D
|
|---|
| 31 | . . . S X=$G(^DGMT(408.31,DA,0))
|
|---|
| 32 | . . . S COUNT=COUNT+1 I '$D(ZTQUEUED),'(COUNT#250) W "."
|
|---|
| 33 | . . . I +X'=K!($P(X,"^",19)'=I)!($P(X,"^",2)'=J) S COUNT(1)=COUNT(1)+1 K ^DGMT(408.31,"AD",I,J,K,DA)
|
|---|
| 34 | I '$D(ZTQUEUED) W !,">>Done...",COUNT(1)," entr",$S(COUNT(1)'=1:"ies",1:"y")," deleted from ""AD"" cross-reference."
|
|---|
| 35 | Q
|
|---|
| 36 | ;
|
|---|
| 37 | ;
|
|---|
| 38 | MAIL ; generate an e-mail bulletin when done
|
|---|
| 39 | N DIFROM
|
|---|
| 40 | S DGCOUNT=0
|
|---|
| 41 | D LINE("The post-init for patch DG*5.3*68 has run to completion."),LINE("")
|
|---|
| 42 | D LINE(COUNT(1)_" entr"_$S(COUNT(1)'=1:"ies",1:"y")_" deleted from ""AD"" cross-reference."),LINE("")
|
|---|
| 43 | D LINE(" Start Time: "_DGSTART)
|
|---|
| 44 | D LINE(" End Time: "_$$NOW^XLFDT()),LINE("")
|
|---|
| 45 | D LINE("Please remove routine DGYPPOST from all systems at this time.")
|
|---|
| 46 | S XMSUB="Patch DG*5.3*68 post-init has completed",XMN=0
|
|---|
| 47 | S XMTEXT="DGTEXT("
|
|---|
| 48 | S XMDUZ=.5,XMY(DUZ)=""
|
|---|
| 49 | D ^XMD
|
|---|
| 50 | K DGCOUNT,DGTEXT,XMDUZ,XMN,XMSUB,XMTEXT,XMY
|
|---|
| 51 | Q
|
|---|
| 52 | ;
|
|---|
| 53 | ;
|
|---|
| 54 | LINE(TEXT) ; add text to mail message
|
|---|
| 55 | S DGCOUNT=DGCOUNT+1,DGTEXT(DGCOUNT)=TEXT
|
|---|
| 56 | Q
|
|---|
| 57 | ;
|
|---|
| 58 | ;
|
|---|
| 59 | TEXT ; text to display
|
|---|
| 60 | ;;You will now be asked for a time to queue the cross-reference
|
|---|
| 61 | ;;clean-up. We recommend you respond NOW as this update can be done
|
|---|
| 62 | ;;with users on the system. It is being queued in order to make the
|
|---|
| 63 | ;;initialization finish faster. Once the clean-up has finished, you
|
|---|
| 64 | ;;will receive an e-mail message.
|
|---|
| 65 | ;;
|
|---|
| 66 | ;;Please note, if you exit (^) without answering the 'Requested Start
|
|---|
| 67 | ;;Time: NOW//' prompt, the cross-reference clean-up will occur
|
|---|
| 68 | ;;immediately.
|
|---|
| 69 | ;;
|
|---|
| 70 | ;;QUIT
|
|---|
