TIU212B.m

TIU212B ; BAYPINES/ELR - UTILITY ROUTINE PATCH TIU*1.0*212 ;3/22/2006

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

 Q

EN NEW TIUDA,TIUS0,TIUNM,TIUCNT,TIUJ,TIUDEV

 S (TIUDA,TIUCNT)=0

 S TIUJ=$J

 K ^TMP("TIU212B",TIUJ)

 F  S TIUDA=$O(^TIU(8925.95,TIUDA)) Q:+TIUDA'>0  D

 .  S TIUS0=$P($G(^TIU(8925.95,TIUDA,0)),U)

 .  S TIUNM=$P($G(^TIU(8925.1,TIUS0,0)),U)

 .  I TIUNM?.E1N.E S TIUCNT=TIUCNT+1,^TMP("TIU212B",TIUJ,TIUCNT)=TIUNM

 I $G(XPDNM)["TIU*1.0*212" D PRINTA G PRINTX

 S TIUDEV=$$DEVICE^TIUDEV(.IO) ; Get Device/allow queueing

 I IO']"" G PRINTX

 I $G(ION)="" G PRINTX

 I $D(IO("Q")) D QUE^TIUDEV("PRINT^TIU212B",TIUDEV) G PRINTX

 D PRINT

PRINTX D ^%ZISC

 Q

PRINT ;

 S TIUDA=0

 U IO

 W !,"Patch TIU*1.0*212 analysis of Document Parameter File (8925.95) entries that"

 W !,"point to titles that contain numbers."

 W !,"Verify that these definitions go with the document.",!!

 W !,"SUSPECT 8925.95 DOCUMENT TITLES"

 W !,"-------------------------------",!

 F  S TIUDA=$O(^TMP("TIU212B",TIUJ,TIUDA)) Q:+TIUDA'>0  D

 . W !,$G(^TMP("TIU212B",TIUJ,TIUDA))

 I $G(TIUCNT)'>0 W !,"NO OCCURANCES FOUND"

 K ^TMP("TIU212B",TIUJ)

 Q 

PRINTA ;

 K ^TMP(TIUJ,"TIU212B")

 NEW TIUHD,TIUCNT1

 S (TIUDA,TIUCNT1)=0

 S TIUHD="Patch TIU*1.0*212 analysis of Document Parameter File (8925.95) entries that"

 D MAIL(TIUHD),BMES^XPDUTL(TIUHD)

 S TIUHD="point to titles that contain numbers."

 D MAIL(TIUHD),MES^XPDUTL(TIUHD)

 S TIUHD="Verify that these definitions go with the document."

 D MAIL(TIUHD),MES^XPDUTL(TIUHD)

 D MAIL(" "),MES^XPDUTL(" ")

 S TIUHD="SUSPECT 8925.95 DOCUMENT TITLES"

 D MAIL(TIUHD),MES^XPDUTL(TIUHD)

 S TIUHD="-------------------------------"

 D MAIL(TIUHD),MES^XPDUTL(TIUHD)

 D MAIL(" "),MES^XPDUTL(" ")

 F  S TIUDA=$O(^TMP("TIU212B",TIUJ,TIUDA)) Q:+TIUDA'>0  D

 . S TIUHD=$G(^TMP("TIU212B",TIUJ,TIUDA))

 . D MAIL(TIUHD),MES^XPDUTL(TIUHD)

 I $G(TIUCNT1)'>0 S TIUHD="NO OCCURANCES FOUND" D MAIL(TIUHD),BMES^XPDUTL(TIUHD)

 K ^TMP("TIU212B",TIUJ)

 S XMSUB="TEXT INTEGRATION UTILITY",XMTEXT="^TMP("_TIUJ_","_"""TIU212B"""_",",XMDUZ="PATCH TIU*1.0*212",XMY(DUZ)=""

 NEW DIFROM D ^XMD K XMDUZ,XMSUB,XMY(DUZ),XMTEXT

 K ^TMP(TIUJ,"TIU212B")

 Q

MAIL(X) ;

 S TIUCNT1=TIUCNT1+1,^TMP(TIUJ,"TIU212B",TIUCNT1)=X

 Q 

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---TIU212B   2275     printed  Feb 19, 2025@00:04:56                                                                                                                                                                                                     Page 2

TIU212B   ; BAYPINES/ELR - UTILITY ROUTINE PATCH TIU*1.0*212 ;3/22/2006

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

 +2        QUIT 

EN         NEW TIUDA,TIUS0,TIUNM,TIUCNT,TIUJ,TIUDEV

 +1        SET (TIUDA,TIUCNT)=0

 +2        SET TIUJ=$JOB

 +3        KILL ^TMP("TIU212B",TIUJ)

 +4        FOR 

               SET TIUDA=$ORDER(^TIU(8925.95,TIUDA))

               if +TIUDA'>0

                   QUIT 

               Begin DoDot:1

 +5                SET TIUS0=$PIECE($GET(^TIU(8925.95,TIUDA,0)),U)

 +6                SET TIUNM=$PIECE($GET(^TIU(8925.1,TIUS0,0)),U)

 +7                IF TIUNM?.E1N.E

                       SET TIUCNT=TIUCNT+1

                       SET ^TMP("TIU212B",TIUJ,TIUCNT)=TIUNM

               End DoDot:1

 +8        IF $GET(XPDNM)["TIU*1.0*212"

               DO PRINTA

               GOTO PRINTX

 +9       ; Get Device/allow queueing

           SET TIUDEV=$$DEVICE^TIUDEV(.IO)

 +10       IF IO']""

               GOTO PRINTX

 +11       IF $GET(ION)=""

               GOTO PRINTX

 +12       IF $DATA(IO("Q"))

               DO QUE^TIUDEV("PRINT^TIU212B",TIUDEV)

               GOTO PRINTX

 +13       DO PRINT

PRINTX     DO ^%ZISC

 +1        QUIT 

PRINT     ;

 +1        SET TIUDA=0

 +2        USE IO

 +3        WRITE !,"Patch TIU*1.0*212 analysis of Document Parameter File (8925.95) entries that"

 +4        WRITE !,"point to titles that contain numbers."

 +5        WRITE !,"Verify that these definitions go with the document.",!!

 +6        WRITE !,"SUSPECT 8925.95 DOCUMENT TITLES"

 +7        WRITE !,"-------------------------------",!

 +8        FOR 

               SET TIUDA=$ORDER(^TMP("TIU212B",TIUJ,TIUDA))

               if +TIUDA'>0

                   QUIT 

               Begin DoDot:1

 +9                WRITE !,$GET(^TMP("TIU212B",TIUJ,TIUDA))

               End DoDot:1

 +10       IF $GET(TIUCNT)'>0

               WRITE !,"NO OCCURANCES FOUND"

 +11       KILL ^TMP("TIU212B",TIUJ)

 +12       QUIT 

PRINTA    ;

 +1        KILL ^TMP(TIUJ,"TIU212B")

 +2        NEW TIUHD,TIUCNT1

 +3        SET (TIUDA,TIUCNT1)=0

 +4        SET TIUHD="Patch TIU*1.0*212 analysis of Document Parameter File (8925.95) entries that"

 +5        DO MAIL(TIUHD)

           DO BMES^XPDUTL(TIUHD)

 +6        SET TIUHD="point to titles that contain numbers."

 +7        DO MAIL(TIUHD)

           DO MES^XPDUTL(TIUHD)

 +8        SET TIUHD="Verify that these definitions go with the document."

 +9        DO MAIL(TIUHD)

           DO MES^XPDUTL(TIUHD)

 +10       DO MAIL(" ")

           DO MES^XPDUTL(" ")

 +11       SET TIUHD="SUSPECT 8925.95 DOCUMENT TITLES"

 +12       DO MAIL(TIUHD)

           DO MES^XPDUTL(TIUHD)

 +13       SET TIUHD="-------------------------------"

 +14       DO MAIL(TIUHD)

           DO MES^XPDUTL(TIUHD)

 +15       DO MAIL(" ")

           DO MES^XPDUTL(" ")

 +16       FOR 

               SET TIUDA=$ORDER(^TMP("TIU212B",TIUJ,TIUDA))

               if +TIUDA'>0

                   QUIT 

               Begin DoDot:1

 +17               SET TIUHD=$GET(^TMP("TIU212B",TIUJ,TIUDA))

 +18               DO MAIL(TIUHD)

                   DO MES^XPDUTL(TIUHD)

               End DoDot:1

 +19       IF $GET(TIUCNT1)'>0

               SET TIUHD="NO OCCURANCES FOUND"

               DO MAIL(TIUHD)

               DO BMES^XPDUTL(TIUHD)

 +20       KILL ^TMP("TIU212B",TIUJ)

 +21       SET XMSUB="TEXT INTEGRATION UTILITY"

           SET XMTEXT="^TMP("_TIUJ_","_"""TIU212B"""_","

           SET XMDUZ="PATCH TIU*1.0*212"

           SET XMY(DUZ)=""

 +22       NEW DIFROM

           DO ^XMD

           KILL XMDUZ,XMSUB,XMY(DUZ),XMTEXT

 +23       KILL ^TMP(TIUJ,"TIU212B")

 +24       QUIT 

MAIL(X)   ;

 +1        SET TIUCNT1=TIUCNT1+1

           SET ^TMP(TIUJ,"TIU212B",TIUCNT1)=X

 +2        QUIT