DGYPPOST.m

DGYPPOST ;ALB/MLI - Clean-up cross-reference on Annual Means Test file ; 20 JUNE 95

 ;;5.3;Registration;**68**;Aug 13, 1993

 ;

 ; This routine will run through entries in the AD cross-reference on

 ; the ANNUAL MEANS TEST file (#408.31) to ensure they are accurate.

 ;

EN ; entry point

 N I,X

 W !! F I=1:1 S X=$P($T(TEXT+I),";;",2) Q:X="QUIT"  W !,X

 S ZTRTN="DQ^DGYPPOST",ZTIO="",ZTDESC="MT X-REF CLEAN-UP"

 D ^%ZTLOAD

 I $D(ZTSK) W !,"Task queued:  ",ZTSK

 E  W "...RUNNING IMMEDIATELY" D DQ W !,"Done!"

 K ZTDESC,ZTIO,ZTRTN,ZTSK

 Q

 ;

 ;

DQ ; call to begin processing

 N DGSTART,COUNT

 S DGSTART=$$NOW^XLFDT()

 D ADCLN,MAIL

 Q

 ;

 ;

ADCLN N I,J,K,X

 S COUNT=0,COUNT(1)=0

 I '$D(ZTQUEUED) W !,">>Checking AD cross-reference and killing erroneous entries..."

 S I=0 F  S I=$O(^DGMT(408.31,"AD",I)) Q:'I  D

 . F J=0:0 S J=$O(^DGMT(408.31,"AD",I,J)) Q:'J  D

 . . F K=0:0 S K=$O(^DGMT(408.31,"AD",I,J,K)) Q:'K  S DA=+$O(^(K,0)) D

 . . . S X=$G(^DGMT(408.31,DA,0))

 . . . S COUNT=COUNT+1 I '$D(ZTQUEUED),'(COUNT#250) W "."

 . . . 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)

 I '$D(ZTQUEUED) W !,">>Done...",COUNT(1)," entr",$S(COUNT(1)'=1:"ies",1:"y")," deleted from ""AD"" cross-reference."

 Q

 ;

 ;

MAIL ; generate an e-mail bulletin when done

 N DIFROM

 S DGCOUNT=0

 D LINE("The post-init for patch DG*5.3*68 has run to completion."),LINE("")

 D LINE(COUNT(1)_" entr"_$S(COUNT(1)'=1:"ies",1:"y")_" deleted from ""AD"" cross-reference."),LINE("")

 D LINE("    Start Time:         "_DGSTART)

 D LINE("    End Time:           "_$$NOW^XLFDT()),LINE("")

 D LINE("Please remove routine DGYPPOST from all systems at this time.")

 S XMSUB="Patch DG*5.3*68 post-init has completed",XMN=0

 S XMTEXT="DGTEXT("

 S XMDUZ=.5,XMY(DUZ)=""

 D ^XMD

 K DGCOUNT,DGTEXT,XMDUZ,XMN,XMSUB,XMTEXT,XMY

 Q

 ;

 ;

LINE(TEXT) ; add text to mail message

 S DGCOUNT=DGCOUNT+1,DGTEXT(DGCOUNT)=TEXT

 Q

 ;

 ;

TEXT ; text to display

 ;;You will now be asked for a time to queue the cross-reference

 ;;clean-up.  We recommend you respond NOW as this update can be done

 ;;with users on the system.  It is being queued in order to make the

 ;;initialization finish faster.  Once the clean-up has finished, you

 ;;will receive an e-mail message.

 ;;

 ;;Please note, if you exit (^) without answering the 'Requested Start

 ;;Time: NOW//' prompt, the cross-reference clean-up will occur

 ;;immediately.

 ;;

 ;;QUIT

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---DGYPPOST   2496     printed  Feb 19, 2025@00:26:29                                                                                                                                                                                                    Page 2

DGYPPOST  ;ALB/MLI - Clean-up cross-reference on Annual Means Test file ; 20 JUNE 95

 +1       ;;5.3;Registration;**68**;Aug 13, 1993

 +2       ;

 +3       ; This routine will run through entries in the AD cross-reference on

 +4       ; the ANNUAL MEANS TEST file (#408.31) to ensure they are accurate.

 +5       ;

EN        ; entry point

 +1        NEW I,X

 +2        WRITE !!

           FOR I=1:1

               SET X=$PIECE($TEXT(TEXT+I),";;",2)

               if X="QUIT"

                   QUIT 

               WRITE !,X

 +3        SET ZTRTN="DQ^DGYPPOST"

           SET ZTIO=""

           SET ZTDESC="MT X-REF CLEAN-UP"

 +4        DO ^%ZTLOAD

 +5        IF $DATA(ZTSK)

               WRITE !,"Task queued:  ",ZTSK

 +6       IF '$TEST

               WRITE "...RUNNING IMMEDIATELY"

               DO DQ

               WRITE !,"Done!"

 +7        KILL ZTDESC,ZTIO,ZTRTN,ZTSK

 +8        QUIT 

 +9       ;

 +10      ;

DQ        ; call to begin processing

 +1        NEW DGSTART,COUNT

 +2        SET DGSTART=$$NOW^XLFDT()

 +3        DO ADCLN

           DO MAIL

 +4        QUIT 

 +5       ;

 +6       ;

ADCLN      NEW I,J,K,X

 +1        SET COUNT=0

           SET COUNT(1)=0

 +2        IF '$DATA(ZTQUEUED)

               WRITE !,">>Checking AD cross-reference and killing erroneous entries..."

 +3        SET I=0

           FOR 

               SET I=$ORDER(^DGMT(408.31,"AD",I))

               if 'I

                   QUIT 

               Begin DoDot:1

 +4                FOR J=0:0

                       SET J=$ORDER(^DGMT(408.31,"AD",I,J))

                       if 'J

                           QUIT 

                       Begin DoDot:2

 +5                        FOR K=0:0

                               SET K=$ORDER(^DGMT(408.31,"AD",I,J,K))

                               if 'K

                                   QUIT 

                               SET DA=+$ORDER(^(K,0))

                               Begin DoDot:3

 +6                                SET X=$GET(^DGMT(408.31,DA,0))

 +7                                SET COUNT=COUNT+1

                                   IF '$DATA(ZTQUEUED)

                                       IF '(COUNT#250)

                                           WRITE "."

 +8                                IF +X'=K!($PIECE(X,"^",19)'=I)!($PIECE(X,"^",2)'=J)

                                       SET COUNT(1)=COUNT(1)+1

                                       KILL ^DGMT(408.31,"AD",I,J,K,DA)

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

 +9        IF '$DATA(ZTQUEUED)

               WRITE !,">>Done...",COUNT(1)," entr",$SELECT(COUNT(1)'=1:"ies",1:"y")," deleted from ""AD"" cross-reference."

 +10       QUIT 

 +11      ;

 +12      ;

MAIL      ; generate an e-mail bulletin when done

 +1        NEW DIFROM

 +2        SET DGCOUNT=0

 +3        DO LINE("The post-init for patch DG*5.3*68 has run to completion.")

           DO LINE("")

 +4        DO LINE(COUNT(1)_" entr"_$SELECT(COUNT(1)'=1:"ies",1:"y")_" deleted from ""AD"" cross-reference.")

           DO LINE("")

 +5        DO LINE("    Start Time:         "_DGSTART)

 +6        DO LINE("    End Time:           "_$$NOW^XLFDT())

           DO LINE("")

 +7        DO LINE("Please remove routine DGYPPOST from all systems at this time.")

 +8        SET XMSUB="Patch DG*5.3*68 post-init has completed"

           SET XMN=0

 +9        SET XMTEXT="DGTEXT("

 +10       SET XMDUZ=.5

           SET XMY(DUZ)=""

 +11       DO ^XMD

 +12       KILL DGCOUNT,DGTEXT,XMDUZ,XMN,XMSUB,XMTEXT,XMY

 +13       QUIT 

 +14      ;

 +15      ;

LINE(TEXT) ; add text to mail message

 +1        SET DGCOUNT=DGCOUNT+1

           SET DGTEXT(DGCOUNT)=TEXT

 +2        QUIT 

 +3       ;

 +4       ;

TEXT      ; text to display

 +1       ;;You will now be asked for a time to queue the cross-reference

 +2       ;;clean-up.  We recommend you respond NOW as this update can be done

 +3       ;;with users on the system.  It is being queued in order to make the

 +4       ;;initialization finish faster.  Once the clean-up has finished, you

 +5       ;;will receive an e-mail message.

 +6       ;;

 +7       ;;Please note, if you exit (^) without answering the 'Requested Start

 +8       ;;Time: NOW//' prompt, the cross-reference clean-up will occur

 +9       ;;immediately.

 +10      ;;

 +11      ;;QUIT