TIUPS98 ; SLC/JER - Post-install TIU*1*98 ;15-JUN-2000 14:53:20
;;1.0;TEXT INTEGRATION UTILITIES;**98**;Jun 20, 1997
MAIN ; Control unit
D DFLTCS
D CLEANUP
Q
DFLTCS ; Remove inappropriate default cosigners
N TIUDA,TIUDUZ,TIUDFCS,TIUCNT S (TIUCNT,TIUDA)=0,XPDIDVT=$G(XPDIDVT,0)
D BMES^XPDUTL("** REMOVING INAPPROPRIATE DEFAULT COSIGNERS **")
S XPDIDTOT=+$P(^TIU(8926,0),U,4) D UPDATE^XPDID(0)
F S TIUDA=$O(^TIU(8926,TIUDA)) Q:+TIUDA'>0 D
. N TIUD0,TIUDUZ,TIUDFCS
. S TIUD0=$G(^TIU(8926,TIUDA,0)),TIUDUZ=+TIUD0,TIUDFCS=+$P(TIUD0,U,9)
. Q:TIUDUZ'=TIUDFCS
. D FIXIT(TIUDA) S TIUCNT=TIUCNT+1 D:'(TIUCNT#10) UPDATE^XPDID(TIUCNT)
Q
FIXIT(DA) ; Remove Default Cosigner when equal to self
N DIE,DR
S DIE=8926,DR=".09///@" D ^DIE
Q
CLEANUP ; Roll-back records that were completed prematurely
N TIUEDT,TIUDA,TIUCNT S TIUCNT=0
S TIUEDT=$$GETSTART Q:+TIUEDT'>0
S ^XTMP("TIUPS98",0)=$$FMADD^XLFDT(DT,90)_U_DT
S ^XTMP("TIUPS98","T0")=$$NOW^XLFDT
D BMES^XPDUTL("** CLEANING UP PREMATURELY COMPLETED DOCUMENTS **")
F S TIUEDT=$O(^TIU(8925,"F",TIUEDT)) Q:+TIUEDT'>0 D
. N TIUDA S TIUDA=+$P($G(^XTMP("TIUPS98","CHKPNT")),U,2)
. F S TIUDA=$O(^TIU(8925,"F",TIUEDT,TIUDA)) Q:+TIUDA'>0 D
. . N TIUD0,TIUD12,TIUD15,TIUES,TIUECS,TIUSBY,TIUCSBY,TIUDPRM
. . S TIUD0=$G(^TIU(8925,TIUDA,0)),TIUD12=$G(^(12)),TIUD15=$G(^(15))
. . Q:+$P(TIUD0,U,5)'>6
. . S TIUES=+$P(TIUD12,U,4) Q:TIUES=0
. . S TIUECS=+$P(TIUD12,U,8) Q:TIUECS=0
. . S TIUSBY=+$P(TIUD15,U,2) Q:TIUSBY=0
. . S TIUCSBY=+$P(TIUD15,U,8) Q:TIUCSBY=0
. . ; NEXT if the signer IS NOT the cosigner
. . Q:TIUSBY'=TIUCSBY
. . ; NEXT if the expected signer IS ALSO the expected cosigner
. . Q:TIUES=TIUECS
. . ; NEXT if the signer IS NOT the expected signer
. . Q:TIUSBY'=TIUES
. . ; NEXT if the cosigner IS NOT the expected signer
. . Q:TIUCSBY'=TIUES
. . D ROLLBACK(TIUDA)
. . S ^XTMP("TIUPS98","CHKPNT")=TIUEDT_U_TIUDA
S ^XTMP("TIUPS98","T1")=$$NOW^XLFDT
I TIUCNT=0 D BMES^XPDUTL("No aberrant documents found...")
Q
GETSTART() ; Find out when Patch TIU*1*79 was installed
N INSTDA,TIUY S INSTDA=""
S TIUY=+$G(^XTMP("TIUPS98","CHKPNT"))
I +TIUY>0 G GETSTX
S INSTDA=$O(^XPD(9.7,"B","TIU*1.0*79",INSTDA),-1)
S TIUY=+$P($G(^XPD(9.7,INSTDA,1)),U,3)
GETSTX Q TIUY
ROLLBACK(DA) ; Remove cosignature and roll-back to uncosigned
N DIE,DR
S DIE=8925
S DR=".05////^S X=6;1506////^S X=1;1507///@;1508///@;1509///@;1510///@;1511///@"
D ^DIE
D SEND^TIUALRT(DA)
S TIUCNT=TIUCNT+1
S ^XTMP("TIUPS98",DA)=""
S ^XTMP("TIUPS98","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 but 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 ---[H[J[2J[HTIUPS98 3245 printed Dec 13, 2024@02:44:29 Page 2
TIUPS98 ; SLC/JER - Post-install TIU*1*98 ;15-JUN-2000 14:53:20
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**98**;Jun 20, 1997
MAIN ; Control unit
+1 DO DFLTCS
+2 DO CLEANUP
+3 QUIT
DFLTCS ; Remove inappropriate default cosigners
+1 NEW TIUDA,TIUDUZ,TIUDFCS,TIUCNT
SET (TIUCNT,TIUDA)=0
SET XPDIDVT=$GET(XPDIDVT,0)
+2 DO BMES^XPDUTL("** REMOVING INAPPROPRIATE DEFAULT COSIGNERS **")
+3 SET XPDIDTOT=+$PIECE(^TIU(8926,0),U,4)
DO UPDATE^XPDID(0)
+4 FOR
SET TIUDA=$ORDER(^TIU(8926,TIUDA))
if +TIUDA'>0
QUIT
Begin DoDot:1
+5 NEW TIUD0,TIUDUZ,TIUDFCS
+6 SET TIUD0=$GET(^TIU(8926,TIUDA,0))
SET TIUDUZ=+TIUD0
SET TIUDFCS=+$PIECE(TIUD0,U,9)
+7 if TIUDUZ'=TIUDFCS
QUIT
+8 DO FIXIT(TIUDA)
SET TIUCNT=TIUCNT+1
if '(TIUCNT#10)
DO UPDATE^XPDID(TIUCNT)
End DoDot:1
+9 QUIT
FIXIT(DA) ; Remove Default Cosigner when equal to self
+1 NEW DIE,DR
+2 SET DIE=8926
SET DR=".09///@"
DO ^DIE
+3 QUIT
CLEANUP ; Roll-back records that were completed prematurely
+1 NEW TIUEDT,TIUDA,TIUCNT
SET TIUCNT=0
+2 SET TIUEDT=$$GETSTART
if +TIUEDT'>0
QUIT
+3 SET ^XTMP("TIUPS98",0)=$$FMADD^XLFDT(DT,90)_U_DT
+4 SET ^XTMP("TIUPS98","T0")=$$NOW^XLFDT
+5 DO BMES^XPDUTL("** CLEANING UP PREMATURELY COMPLETED DOCUMENTS **")
+6 FOR
SET TIUEDT=$ORDER(^TIU(8925,"F",TIUEDT))
if +TIUEDT'>0
QUIT
Begin DoDot:1
+7 NEW TIUDA
SET TIUDA=+$PIECE($GET(^XTMP("TIUPS98","CHKPNT")),U,2)
+8 FOR
SET TIUDA=$ORDER(^TIU(8925,"F",TIUEDT,TIUDA))
if +TIUDA'>0
QUIT
Begin DoDot:2
+9 NEW TIUD0,TIUD12,TIUD15,TIUES,TIUECS,TIUSBY,TIUCSBY,TIUDPRM
+10 SET TIUD0=$GET(^TIU(8925,TIUDA,0))
SET TIUD12=$GET(^(12))
SET TIUD15=$GET(^(15))
+11 if +$PIECE(TIUD0,U,5)'>6
QUIT
+12 SET TIUES=+$PIECE(TIUD12,U,4)
if TIUES=0
QUIT
+13 SET TIUECS=+$PIECE(TIUD12,U,8)
if TIUECS=0
QUIT
+14 SET TIUSBY=+$PIECE(TIUD15,U,2)
if TIUSBY=0
QUIT
+15 SET TIUCSBY=+$PIECE(TIUD15,U,8)
if TIUCSBY=0
QUIT
+16 ; NEXT if the signer IS NOT the cosigner
+17 if TIUSBY'=TIUCSBY
QUIT
+18 ; NEXT if the expected signer IS ALSO the expected cosigner
+19 if TIUES=TIUECS
QUIT
+20 ; NEXT if the signer IS NOT the expected signer
+21 if TIUSBY'=TIUES
QUIT
+22 ; NEXT if the cosigner IS NOT the expected signer
+23 if TIUCSBY'=TIUES
QUIT
+24 DO ROLLBACK(TIUDA)
+25 SET ^XTMP("TIUPS98","CHKPNT")=TIUEDT_U_TIUDA
End DoDot:2
End DoDot:1
+26 SET ^XTMP("TIUPS98","T1")=$$NOW^XLFDT
+27 IF TIUCNT=0
DO BMES^XPDUTL("No aberrant documents found...")
+28 QUIT
GETSTART() ; Find out when Patch TIU*1*79 was installed
+1 NEW INSTDA,TIUY
SET INSTDA=""
+2 SET TIUY=+$GET(^XTMP("TIUPS98","CHKPNT"))
+3 IF +TIUY>0
GOTO GETSTX
+4 SET INSTDA=$ORDER(^XPD(9.7,"B","TIU*1.0*79",INSTDA),-1)
+5 SET TIUY=+$PIECE($GET(^XPD(9.7,INSTDA,1)),U,3)
GETSTX QUIT TIUY
ROLLBACK(DA) ; Remove cosignature and roll-back to uncosigned
+1 NEW DIE,DR
+2 SET DIE=8925
+3 SET DR=".05////^S X=6;1506////^S X=1;1507///@;1508///@;1509///@;1510///@;1511///@"
+4 DO ^DIE
+5 DO SEND^TIUALRT(DA)
+6 SET TIUCNT=TIUCNT+1
+7 SET ^XTMP("TIUPS98",DA)=""
+8 SET ^XTMP("TIUPS98","COUNT")=TIUCNT
+9 IF $SELECT(TIUCNT=1:1,'(TIUCNT#50):1,1:0)
DO MES^XPDUTL($$GETMSG(TIUCNT\50))
+10 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 but 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...
