source: WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGYPPOST.m@ 789

Last change on this file since 789 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.4 KB
Line 
1DGYPPOST ;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 ;
7EN ; 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 ;
18DQ ; call to begin processing
19 N DGSTART,COUNT
20 S DGSTART=$$NOW^XLFDT()
21 D ADCLN,MAIL
22 Q
23 ;
24 ;
25ADCLN 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 ;
38MAIL ; 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 ;
54LINE(TEXT) ; add text to mail message
55 S DGCOUNT=DGCOUNT+1,DGTEXT(DGCOUNT)=TEXT
56 Q
57 ;
58 ;
59TEXT ; 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
Note: See TracBrowser for help on using the repository browser.