TIURD4 ; SLC/JER - Reassign actions ;13-APR-2001 14:29:02
;;1.0;TEXT INTEGRATION UTILITIES;**61,100**;Jun 20, 1997
FROMTO(TIUDA,TIUDAT) ; Display the from/to information
N TIUF,TIUT,TIUDAD,TIUFEDT,TIUFLDT,TIUTEDT,TIUTLDT
S TIUDAD=$P($G(^TIU(8925,+TIUDA,0)),U,6)
D GETTIU^TIULD(.TIUF,+TIUDAD)
D GETTIU^TIULD(.TIUT,+TIUDAT)
S TIUFEDT=$$DATE^TIULS($P(TIUF("EDT"),U),"MM/DD/YY")
S TIUFLDT=$$DATE^TIULS($P(TIUF("LDT"),U),"MM/DD/YY")
S TIUTEDT=$$DATE^TIULS($P(TIUT("EDT"),U),"MM/DD/YY")
S TIUTLDT=$$DATE^TIULS($P(TIUT("LDT"),U),"MM/DD/YY")
W !!,"You are about to move the addendum as follows:",!
W !,?5,"From",?45,"To",!
W !,$P(TIUF("DOCTYP"),U,2),?35," --> ",?40,$P(TIUT("DOCTYP"),U,2)
W !,TIUF("PNM")," ",TIUF("PID"),?35," --> ",?40,TIUT("PNM")," ",TIUT("PID")
W !,TIUFEDT,$S($L(TIUFLDT):" - "_TIUFLDT,1:""),?35," --> "
W ?40,TIUTEDT,$S($L(TIUTLDT):" - "_TIUTLDT,1:""),!
Q
UPDSTAT(DA) ; Update the status of the named record
N DIE,DR
S DIE=8925,DR=".05///^S X=$$STATUS^TIULC(DA)"
D ^DIE
Q
LOADSB(TIUODA,TIUADA,TIUOS,TIUAS) ; Load arrays w/Sig Blocks
N TIUOD15,TIUAD15
S TIUOD15=$G(^TIU(8925,TIUODA,15))
S TIUOS("SBN")=$S($P(TIUOD15,U,3)]"":$$DECRYPT(TIUODA,$P(TIUOD15,U,3)),1:"@")
S TIUOS("SBT")=$S($P(TIUOD15,U,4)]"":$$DECRYPT(TIUODA,$P(TIUOD15,U,4)),1:"@")
S TIUOS("CSBN")=$S($P(TIUOD15,U,9)]"":$$DECRYPT(TIUODA,$P(TIUOD15,U,9)),1:"@")
S TIUOS("CSBT")=$S($P(TIUOD15,U,10)]"":$$DECRYPT(TIUODA,$P(TIUOD15,U,10)),1:"@")
S TIUAD15=$G(^TIU(8925,TIUADA,15))
S TIUAS("SBN")=$S($P(TIUAD15,U,3)]"":$$DECRYPT(TIUADA,$P(TIUAD15,U,3)),1:"@")
S TIUAS("SBT")=$S($P(TIUAD15,U,4)]"":$$DECRYPT(TIUADA,$P(TIUAD15,U,4)),1:"@")
S TIUAS("CSBN")=$S($P(TIUAD15,U,9)]"":$$DECRYPT(TIUADA,$P(TIUAD15,U,9)),1:"@")
S TIUAS("CSBT")=$S($P(TIUAD15,U,10)]"":$$DECRYPT(TIUADA,$P(TIUAD15,U,10)),1:"@")
Q
SWAPSB(TIUODA,TIUADA,TIUOS,TIUAS) ; Swap Signature blocks
N DA,DIE,DR
S DR="1503///^S X=TIUAS(""SBN"");1504///^S X=TIUAS(""SBT"")"
S DR=DR_";1509///^S X=TIUAS(""CSBN"");1510///^S X=TIUAS(""CSBT"")"
S DA=TIUODA,DIE="^TIU(8925," D ^DIE K DR
S DR="1503///^S X=TIUOS(""SBN"");1504///^S X=TIUOS(""SBT"")"
S DR=DR_";1509///^S X=TIUOS(""CSBN"");1510///^S X=TIUOS(""CSBT"")"
S DA=TIUADA,DIE="^TIU(8925," D ^DIE K DR
Q
DECRYPT(TIUDA,TIUX) ; Decrypt signature blocks
N TIUY
S TIUY=$$DECRYPT^TIULC1(TIUX,1,$$CHKSUM^TIULC("^TIU(8925,"_+TIUDA_",""TEXT"")"))
Q TIUY
RECOVER(TIUODA,TIUDA,TIUD0) ; Restore original state on abort
N DIE,DR,DA,DIDEL,TIUI
W $C(7),$C(7),!!,"Transaction aborted. Restoring records to original state..."
; Loop thru ^TMP("TIURTRCT",$J,DA) and restore prior state
I '$D(^TMP("TIURTRCT",$J,TIUODA)) D
. W !!,"** Can't Restore to Prior State...'$D(^TMP(""TIURTRCT"",$J,TIUODA)) **"
S TIUI=0 F S TIUI=$O(^TMP("TIURTRCT",$J,TIUI)) Q:+TIUI'>0 D
. N DIE,DR,X,Y,TIUD0,DA
. S DA=TIUI,TIUD0=^TMP("TIURTRCT",$J,DA,0)
. S DIE=8925
. S DR=".03////^S X=$P(TIUD0,U,3);.05////^S X=$P(TIUD0,U,5);.06////^S X=$P(TIUD0,U,6)"
. D ^DIE
; Loop thru ^TMP("TIURTRCT",$J,"NEW",DA) and delete duplicate notes
I '$D(^TMP("TIURTRCT",$J,"NEW",TIUDA)) D
. W !!,"** Can't Restore to Prior State...'$D(^TMP(""TIURTRCT"",$J,""NEW"",TIUDA)) **"
S TIUI=0 F S TIUI=$O(^TMP("TIURTRCT",$J,"NEW",TIUI)) Q:+TIUI'>0 D
. D DELDOC(TIUI)
H 3
Q
DELDOC(DA) ; Delete document and components--NOT its addenda
N DIE,DIDEL,DR,X,Y,TIUDA,TIUI
S TIUDA=DA
; First, delete audit trail entries
D DELAUDIT^TIUEDI1(TIUDA)
D DELSGNRS(TIUDA)
; Next, delete the document's components
S TIUI=0 F S TIUI=$O(^TIU(8925,"DAD",TIUDA,TIUI)) Q:+TIUI'>0 D
. I +$$ISADDNDM^TIULC1(TIUI) Q
. D DELDOC(TIUI)
S (DIDEL,DIE)=8925,DR=".01///@"
D ^DIE ; Delete duplicate note
Q
DELSGNRS(TIUDA,UNSIGN) ; Remove Additional signers
N DA S DA=0
F S DA=$O(^TIU(8925.7,"B",TIUDA,DA)) Q:+DA'>0 D
. N DIK,DIDEL
. I +$G(UNSIGN),(+$P(^TIU(8925.7,DA,0),U,4)>0) Q
. S DIK="^TIU(8925.7,",DIDEL=8925.7 D ^DIK
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIURD4 3981 printed Oct 16, 2024@18:45:46 Page 2
TIURD4 ; SLC/JER - Reassign actions ;13-APR-2001 14:29:02
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**61,100**;Jun 20, 1997
FROMTO(TIUDA,TIUDAT) ; Display the from/to information
+1 NEW TIUF,TIUT,TIUDAD,TIUFEDT,TIUFLDT,TIUTEDT,TIUTLDT
+2 SET TIUDAD=$PIECE($GET(^TIU(8925,+TIUDA,0)),U,6)
+3 DO GETTIU^TIULD(.TIUF,+TIUDAD)
+4 DO GETTIU^TIULD(.TIUT,+TIUDAT)
+5 SET TIUFEDT=$$DATE^TIULS($PIECE(TIUF("EDT"),U),"MM/DD/YY")
+6 SET TIUFLDT=$$DATE^TIULS($PIECE(TIUF("LDT"),U),"MM/DD/YY")
+7 SET TIUTEDT=$$DATE^TIULS($PIECE(TIUT("EDT"),U),"MM/DD/YY")
+8 SET TIUTLDT=$$DATE^TIULS($PIECE(TIUT("LDT"),U),"MM/DD/YY")
+9 WRITE !!,"You are about to move the addendum as follows:",!
+10 WRITE !,?5,"From",?45,"To",!
+11 WRITE !,$PIECE(TIUF("DOCTYP"),U,2),?35," --> ",?40,$PIECE(TIUT("DOCTYP"),U,2)
+12 WRITE !,TIUF("PNM")," ",TIUF("PID"),?35," --> ",?40,TIUT("PNM")," ",TIUT("PID")
+13 WRITE !,TIUFEDT,$SELECT($LENGTH(TIUFLDT):" - "_TIUFLDT,1:""),?35," --> "
+14 WRITE ?40,TIUTEDT,$SELECT($LENGTH(TIUTLDT):" - "_TIUTLDT,1:""),!
+15 QUIT
UPDSTAT(DA) ; Update the status of the named record
+1 NEW DIE,DR
+2 SET DIE=8925
SET DR=".05///^S X=$$STATUS^TIULC(DA)"
+3 DO ^DIE
+4 QUIT
LOADSB(TIUODA,TIUADA,TIUOS,TIUAS) ; Load arrays w/Sig Blocks
+1 NEW TIUOD15,TIUAD15
+2 SET TIUOD15=$GET(^TIU(8925,TIUODA,15))
+3 SET TIUOS("SBN")=$SELECT($PIECE(TIUOD15,U,3)]"":$$DECRYPT(TIUODA,$PIECE(TIUOD15,U,3)),1:"@")
+4 SET TIUOS("SBT")=$SELECT($PIECE(TIUOD15,U,4)]"":$$DECRYPT(TIUODA,$PIECE(TIUOD15,U,4)),1:"@")
+5 SET TIUOS("CSBN")=$SELECT($PIECE(TIUOD15,U,9)]"":$$DECRYPT(TIUODA,$PIECE(TIUOD15,U,9)),1:"@")
+6 SET TIUOS("CSBT")=$SELECT($PIECE(TIUOD15,U,10)]"":$$DECRYPT(TIUODA,$PIECE(TIUOD15,U,10)),1:"@")
+7 SET TIUAD15=$GET(^TIU(8925,TIUADA,15))
+8 SET TIUAS("SBN")=$SELECT($PIECE(TIUAD15,U,3)]"":$$DECRYPT(TIUADA,$PIECE(TIUAD15,U,3)),1:"@")
+9 SET TIUAS("SBT")=$SELECT($PIECE(TIUAD15,U,4)]"":$$DECRYPT(TIUADA,$PIECE(TIUAD15,U,4)),1:"@")
+10 SET TIUAS("CSBN")=$SELECT($PIECE(TIUAD15,U,9)]"":$$DECRYPT(TIUADA,$PIECE(TIUAD15,U,9)),1:"@")
+11 SET TIUAS("CSBT")=$SELECT($PIECE(TIUAD15,U,10)]"":$$DECRYPT(TIUADA,$PIECE(TIUAD15,U,10)),1:"@")
+12 QUIT
SWAPSB(TIUODA,TIUADA,TIUOS,TIUAS) ; Swap Signature blocks
+1 NEW DA,DIE,DR
+2 SET DR="1503///^S X=TIUAS(""SBN"");1504///^S X=TIUAS(""SBT"")"
+3 SET DR=DR_";1509///^S X=TIUAS(""CSBN"");1510///^S X=TIUAS(""CSBT"")"
+4 SET DA=TIUODA
SET DIE="^TIU(8925,"
DO ^DIE
KILL DR
+5 SET DR="1503///^S X=TIUOS(""SBN"");1504///^S X=TIUOS(""SBT"")"
+6 SET DR=DR_";1509///^S X=TIUOS(""CSBN"");1510///^S X=TIUOS(""CSBT"")"
+7 SET DA=TIUADA
SET DIE="^TIU(8925,"
DO ^DIE
KILL DR
+8 QUIT
DECRYPT(TIUDA,TIUX) ; Decrypt signature blocks
+1 NEW TIUY
+2 SET TIUY=$$DECRYPT^TIULC1(TIUX,1,$$CHKSUM^TIULC("^TIU(8925,"_+TIUDA_",""TEXT"")"))
+3 QUIT TIUY
RECOVER(TIUODA,TIUDA,TIUD0) ; Restore original state on abort
+1 NEW DIE,DR,DA,DIDEL,TIUI
+2 WRITE $CHAR(7),$CHAR(7),!!,"Transaction aborted. Restoring records to original state..."
+3 ; Loop thru ^TMP("TIURTRCT",$J,DA) and restore prior state
+4 IF '$DATA(^TMP("TIURTRCT",$JOB,TIUODA))
Begin DoDot:1
+5 WRITE !!,"** Can't Restore to Prior State...'$D(^TMP(""TIURTRCT"",$J,TIUODA)) **"
End DoDot:1
+6 SET TIUI=0
FOR
SET TIUI=$ORDER(^TMP("TIURTRCT",$JOB,TIUI))
if +TIUI'>0
QUIT
Begin DoDot:1
+7 NEW DIE,DR,X,Y,TIUD0,DA
+8 SET DA=TIUI
SET TIUD0=^TMP("TIURTRCT",$JOB,DA,0)
+9 SET DIE=8925
+10 SET DR=".03////^S X=$P(TIUD0,U,3);.05////^S X=$P(TIUD0,U,5);.06////^S X=$P(TIUD0,U,6)"
+11 DO ^DIE
End DoDot:1
+12 ; Loop thru ^TMP("TIURTRCT",$J,"NEW",DA) and delete duplicate notes
+13 IF '$DATA(^TMP("TIURTRCT",$JOB,"NEW",TIUDA))
Begin DoDot:1
+14 WRITE !!,"** Can't Restore to Prior State...'$D(^TMP(""TIURTRCT"",$J,""NEW"",TIUDA)) **"
End DoDot:1
+15 SET TIUI=0
FOR
SET TIUI=$ORDER(^TMP("TIURTRCT",$JOB,"NEW",TIUI))
if +TIUI'>0
QUIT
Begin DoDot:1
+16 DO DELDOC(TIUI)
End DoDot:1
+17 HANG 3
+18 QUIT
DELDOC(DA) ; Delete document and components--NOT its addenda
+1 NEW DIE,DIDEL,DR,X,Y,TIUDA,TIUI
+2 SET TIUDA=DA
+3 ; First, delete audit trail entries
+4 DO DELAUDIT^TIUEDI1(TIUDA)
+5 DO DELSGNRS(TIUDA)
+6 ; Next, delete the document's components
+7 SET TIUI=0
FOR
SET TIUI=$ORDER(^TIU(8925,"DAD",TIUDA,TIUI))
if +TIUI'>0
QUIT
Begin DoDot:1
+8 IF +$$ISADDNDM^TIULC1(TIUI)
QUIT
+9 DO DELDOC(TIUI)
End DoDot:1
+10 SET (DIDEL,DIE)=8925
SET DR=".01///@"
+11 ; Delete duplicate note
DO ^DIE
+12 QUIT
DELSGNRS(TIUDA,UNSIGN) ; Remove Additional signers
+1 NEW DA
SET DA=0
+2 FOR
SET DA=$ORDER(^TIU(8925.7,"B",TIUDA,DA))
if +DA'>0
QUIT
Begin DoDot:1
+3 NEW DIK,DIDEL
+4 IF +$GET(UNSIGN)
IF (+$PIECE(^TIU(8925.7,DA,0),U,4)>0)
QUIT
+5 SET DIK="^TIU(8925.7,"
SET DIDEL=8925.7
DO ^DIK
End DoDot:1
+6 QUIT
