TIUPS104.m

TIUPS104 ; SLC/JER - Post-install TIU*1*104 ;20-SEP-2000 14:22:20

 ;;1.0;TEXT INTEGRATION UTILITIES;**104**;Jun 20, 1997

MAIN ; Control unit

 D CLEANUP

 Q

CLEANUP ; Correct PARENT DOCUMENT CLASS field for records that were filed with bad values

 N TIUEDT,TIUDA,TIUCNT S TIUCNT=0

 S TIUEDT=$$GETSTART Q:+TIUEDT'>0

 S ^XTMP("TIUPS104",0)=$$FMADD^XLFDT(DT,90)_U_DT

 S ^XTMP("TIUPS104","T0")=$$NOW^XLFDT

 D BMES^XPDUTL("** CLEANING UP DOCUMENTS WITH BAD DOCUMENT CLASS VALUES **")

 F  S TIUEDT=$O(^TIU(8925,"F",TIUEDT)) Q:+TIUEDT'>0  D

 . N TIUDA S TIUDA=0

 . F  S TIUDA=$O(^TIU(8925,"F",TIUEDT,TIUDA)) Q:+TIUDA'>0  D

 . . N TIUD0,TIUDCLS,TIUCDCLS

 . . S TIUD0=$G(^TIU(8925,TIUDA,0)),TIUDCLS=$P(TIUD0,U,4)

 . . S TIUCDCLS=$$DOCCLASS^TIULC1(+TIUD0)

 . . ; Don't process records where Document Class is correct

 . . Q:TIUCDCLS=TIUDCLS

 . . D FIXIT(TIUDA,TIUCDCLS,TIUDCLS)

 . . S ^XTMP("TIUPS104","CHKPNT")=TIUEDT_U_TIUDA

 S ^XTMP("TIUPS104","T1")=$$NOW^XLFDT

 I TIUCNT=0 D BMES^XPDUTL("No aberrant documents found...")

 Q

GETSTART()      ; Get the starting date

 N TIUY

 S TIUY=+$G(^XTMP("TIUPS104","CHKPNT"))

 I +TIUY>0 G GETSTX

 S TIUY=$$FMADD^XLFDT(DT,-180)

GETSTX Q TIUY

FIXIT(DA,TIUCDCLS,TIUDCLS)    ; file the corrected document class

 N DIE,DR

 S DIE=8925

 S DR=".04////^S X=TIUCDCLS"

 D ^DIE

 S TIUCNT=TIUCNT+1

 S ^XTMP("TIUPS104",DA)=TIUDCLS_U_TIUCDCLS

 S ^XTMP("TIUPS104","COUNT")=TIUCNT

 I $S(TIUCNT=1:1,'(TIUCNT#50):1,1:0) D MES^XPDUTL($$GETMSG(TIUCNT\50))

 Q

GETMSG(LINE)    ; Get a message of encouragement...

 Q $P($T(MSG+$S(LINE'>10:LINE,1:$R(10))),";",3)

MSG ; List of messages

 ;;Hang in there, this won't take too much longer...

 ;;Boy, you've got a lot of these!

 ;;What were you expecting, animated .gif's or something?

 ;;"I like New York in June, how about you?"

 ;;"I like a Gershwin tune, how about you?"

 ;;Aren't you glad that I didn't ask "IS EVERYTHING OK?"

 ;;DILBERT RULES!

 ;;Don't worry, I'll be done LONG before we have a mass transit subsidy...

 ;;You will be assimilated...

 ;;Resistence is futile...

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---TIUPS104   2084     printed  Apr 09, 2024@21:48:56                                                                                                                                                                                                    Page 2

TIUPS104  ; SLC/JER - Post-install TIU*1*104 ;20-SEP-2000 14:22:20

 +1       ;;1.0;TEXT INTEGRATION UTILITIES;**104**;Jun 20, 1997

MAIN      ; Control unit

 +1        DO CLEANUP

 +2        QUIT 

CLEANUP   ; Correct PARENT DOCUMENT CLASS field for records that were filed with bad values

 +1        NEW TIUEDT,TIUDA,TIUCNT

           SET TIUCNT=0

 +2        SET TIUEDT=$$GETSTART

           if +TIUEDT'>0

               QUIT 

 +3        SET ^XTMP("TIUPS104",0)=$$FMADD^XLFDT(DT,90)_U_DT

 +4        SET ^XTMP("TIUPS104","T0")=$$NOW^XLFDT

 +5        DO BMES^XPDUTL("** CLEANING UP DOCUMENTS WITH BAD DOCUMENT CLASS VALUES **")

 +6        FOR 

               SET TIUEDT=$ORDER(^TIU(8925,"F",TIUEDT))

               if +TIUEDT'>0

                   QUIT 

               Begin DoDot:1

 +7                NEW TIUDA

                   SET TIUDA=0

 +8                FOR 

                       SET TIUDA=$ORDER(^TIU(8925,"F",TIUEDT,TIUDA))

                       if +TIUDA'>0

                           QUIT 

                       Begin DoDot:2

 +9                        NEW TIUD0,TIUDCLS,TIUCDCLS

 +10                       SET TIUD0=$GET(^TIU(8925,TIUDA,0))

                           SET TIUDCLS=$PIECE(TIUD0,U,4)

 +11                       SET TIUCDCLS=$$DOCCLASS^TIULC1(+TIUD0)

 +12      ; Don't process records where Document Class is correct

 +13                       if TIUCDCLS=TIUDCLS

                               QUIT 

 +14                       DO FIXIT(TIUDA,TIUCDCLS,TIUDCLS)

 +15                       SET ^XTMP("TIUPS104","CHKPNT")=TIUEDT_U_TIUDA

                       End DoDot:2

               End DoDot:1

 +16       SET ^XTMP("TIUPS104","T1")=$$NOW^XLFDT

 +17       IF TIUCNT=0

               DO BMES^XPDUTL("No aberrant documents found...")

 +18       QUIT 

GETSTART() ; Get the starting date

 +1        NEW TIUY

 +2        SET TIUY=+$GET(^XTMP("TIUPS104","CHKPNT"))

 +3        IF +TIUY>0

               GOTO GETSTX

 +4        SET TIUY=$$FMADD^XLFDT(DT,-180)

GETSTX     QUIT TIUY

FIXIT(DA,TIUCDCLS,TIUDCLS) ; file the corrected document class

 +1        NEW DIE,DR

 +2        SET DIE=8925

 +3        SET DR=".04////^S X=TIUCDCLS"

 +4        DO ^DIE

 +5        SET TIUCNT=TIUCNT+1

 +6        SET ^XTMP("TIUPS104",DA)=TIUDCLS_U_TIUCDCLS

 +7        SET ^XTMP("TIUPS104","COUNT")=TIUCNT

 +8        IF $SELECT(TIUCNT=1:1,'(TIUCNT#50):1,1:0)

               DO MES^XPDUTL($$GETMSG(TIUCNT\50))

 +9        QUIT 

GETMSG(LINE) ; Get a message of encouragement...

 +1        QUIT $PIECE($TEXT(MSG+$SELECT(LINE'>10:LINE,1:$RANDOM(10))),";",3)

MSG       ; List of messages

 +1       ;;Hang in there, this won't take too much longer...

 +2       ;;Boy, you've got a lot of these!

 +3       ;;What were you expecting, animated .gif's or something?

 +4       ;;"I like New York in June, how about you?"

 +5       ;;"I like a Gershwin tune, how about you?"

 +6       ;;Aren't you glad that I didn't ask "IS EVERYTHING OK?"

 +7       ;;DILBERT RULES!

 +8       ;;Don't worry, I'll be done LONG before we have a mass transit subsidy...

 +9       ;;You will be assimilated...

 +10      ;;Resistence is futile...