Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: TIUPS98

TIUPS98.m

Go to the documentation of this file. 
  1. TIUPS98 ; SLC/JER - Post-install TIU*1*98 ;15-JUN-2000 14:53:20
  1.  ;;1.0;TEXT INTEGRATION UTILITIES;**98**;Jun 20, 1997
  1. MAIN ; Control unit
  1.  D DFLTCS
  1.  D CLEANUP
  1.  Q
  1. DFLTCS ; Remove inappropriate default cosigners
  1.  N TIUDA,TIUDUZ,TIUDFCS,TIUCNT S (TIUCNT,TIUDA)=0,XPDIDVT=$G(XPDIDVT,0)
  1.  D BMES^XPDUTL("** REMOVING INAPPROPRIATE DEFAULT COSIGNERS **")
  1.  S XPDIDTOT=+$P(^TIU(8926,0),U,4) D UPDATE^XPDID(0)
  1.  F  S TIUDA=$O(^TIU(8926,TIUDA)) Q:+TIUDA'>0  D
  1.  . N TIUD0,TIUDUZ,TIUDFCS
  1.  . S TIUD0=$G(^TIU(8926,TIUDA,0)),TIUDUZ=+TIUD0,TIUDFCS=+$P(TIUD0,U,9)
  1.  . Q:TIUDUZ'=TIUDFCS
  1.  . D FIXIT(TIUDA) S TIUCNT=TIUCNT+1 D:'(TIUCNT#10) UPDATE^XPDID(TIUCNT)
  1.  Q
  1. FIXIT(DA) ; Remove Default Cosigner when equal to self
  1.  N DIE,DR
  1.  S DIE=8926,DR=".09///@" D ^DIE
  1.  Q
  1. CLEANUP ; Roll-back records that were completed prematurely
  1.  N TIUEDT,TIUDA,TIUCNT S TIUCNT=0
  1.  S TIUEDT=$$GETSTART Q:+TIUEDT'>0
  1.  S ^XTMP("TIUPS98",0)=$$FMADD^XLFDT(DT,90)_U_DT
  1.  S ^XTMP("TIUPS98","T0")=$$NOW^XLFDT
  1.  D BMES^XPDUTL("** CLEANING UP PREMATURELY COMPLETED DOCUMENTS **")
  1.  F  S TIUEDT=$O(^TIU(8925,"F",TIUEDT)) Q:+TIUEDT'>0  D
  1.  . N TIUDA S TIUDA=+$P($G(^XTMP("TIUPS98","CHKPNT")),U,2)
  1.  . F  S TIUDA=$O(^TIU(8925,"F",TIUEDT,TIUDA)) Q:+TIUDA'>0  D
  1.  . . N TIUD0,TIUD12,TIUD15,TIUES,TIUECS,TIUSBY,TIUCSBY,TIUDPRM
  1.  . . S TIUD0=$G(^TIU(8925,TIUDA,0)),TIUD12=$G(^(12)),TIUD15=$G(^(15))
  1.  . . Q:+$P(TIUD0,U,5)'>6
  1.  . . S TIUES=+$P(TIUD12,U,4) Q:TIUES=0
  1.  . . S TIUECS=+$P(TIUD12,U,8) Q:TIUECS=0
  1.  . . S TIUSBY=+$P(TIUD15,U,2) Q:TIUSBY=0
  1.  . . S TIUCSBY=+$P(TIUD15,U,8) Q:TIUCSBY=0
  1.  . . ; NEXT if the signer IS NOT the cosigner
  1.  . . Q:TIUSBY'=TIUCSBY
  1.  . . ; NEXT if the expected signer IS ALSO the expected cosigner
  1.  . . Q:TIUES=TIUECS
  1.  . . ; NEXT if the signer IS NOT the expected signer
  1.  . . Q:TIUSBY'=TIUES
  1.  . . ; NEXT if the cosigner IS NOT the expected signer
  1.  . . Q:TIUCSBY'=TIUES
  1.  . . D ROLLBACK(TIUDA)
  1.  . . S ^XTMP("TIUPS98","CHKPNT")=TIUEDT_U_TIUDA
  1.  S ^XTMP("TIUPS98","T1")=$$NOW^XLFDT
  1.  I TIUCNT=0 D BMES^XPDUTL("No aberrant documents found...")
  1.  Q
  1. GETSTART()      ; Find out when Patch TIU*1*79 was installed
  1.  N INSTDA,TIUY S INSTDA=""
  1.  S TIUY=+$G(^XTMP("TIUPS98","CHKPNT"))
  1.  I +TIUY>0 G GETSTX
  1.  S INSTDA=$O(^XPD(9.7,"B","TIU*1.0*79",INSTDA),-1)
  1.  S TIUY=+$P($G(^XPD(9.7,INSTDA,1)),U,3)
  1. GETSTX Q TIUY
  1. ROLLBACK(DA)    ; Remove cosignature and roll-back to uncosigned
  1.  N DIE,DR
  1.  S DIE=8925
  1.  S DR=".05////^S X=6;1506////^S X=1;1507///@;1508///@;1509///@;1510///@;1511///@"
  1.  D ^DIE
  1.  D SEND^TIUALRT(DA)
  1.  S TIUCNT=TIUCNT+1
  1.  S ^XTMP("TIUPS98",DA)=""
  1.  S ^XTMP("TIUPS98","COUNT")=TIUCNT
  1.  I $S(TIUCNT=1:1,'(TIUCNT#50):1,1:0) D MES^XPDUTL($$GETMSG(TIUCNT\50))
  1.  Q
  1. GETMSG(LINE)    ; Get a message of encouragement...
  1.  Q $P($T(MSG+$S(LINE'>10:LINE,1:$R(10))),";",3)
  1. MSG ; List of messages
  1.  ;;Hang in there, this won't take but too much longer...
  1.  ;;Boy, you've got a lot of these!
  1.  ;;What were you expecting, animated .gif's or something?
  1.  ;;"I like New York in June, how about you?"
  1.  ;;"I like a Gershwin tune, how about you?"
  1.  ;;Aren't you glad that I didn't ask "IS EVERYTHING OK?"
  1.  ;;DILBERT RULES!
  1.  ;;Don't worry, I'll be done LONG before we have a mass transit subsidy...
  1.  ;;You will be assimilated...
  1.  ;;Resistence is futile...