- 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 Jan 18, 2025@03:46:20 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