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 ---[H[J[2J[HTIU212B 2275 printed Dec 13, 2024@02:38:28 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
