- TIURD1 ; SLC/JER - Reassign actions ;4/18/03
- ;;1.0;TEXT INTEGRATION UTILITIES;**1,7,61,113**;Jun 20, 1997
- MOVEADD(TIUDA) ; Move an addendum to another document
- N DFN,TIUDAT,TIUSCRN,TIUMOVE,TIUTYP,TIUODA
- S TIUTYP=$$CLINDOC^TIULC1(+$G(^TIU(8925,+$P($G(^TIU(8925,+TIUDA,0)),U,6),0)))
- I +TIUTYP'>0 S TIUTYP=38
- S TIUTYP(1)="1^"_TIUTYP_U_$P(^TIU(8925.1,+TIUTYP,0),U)
- S DFN=+$$PATIENT^TIULA
- I +DFN'>0 D Q
- . W !!,"No PATIENT Selected: Aborting Transaction, No Harm Done...",!
- . I $$READ^TIUU("EA","Press RETURN to continue...") ; pause
- . S TIUOUT=1
- ; --- If moving to different pt, keep retracted original ---
- I +$G(DFN)'=$P(TIUD0(0),U,2),(+$P(TIUD0(0),U,5)>5) D
- . W !,"Moving signed document to another Patient...A RETRACTED copy will be retained."
- . S TIUODA=TIUDA,TIUDA=+$$RETRACT^TIURD2(TIUDA)
- Q:+TIUDA'>0
- D SELPAT^TIULA2(.TIUDAT,TIUTYP,DFN)
- I +$G(TIUDAT)'>0,($D(TIUDAT)'>9) S TIUOUT=1 G ABORT
- S TIUDAT=+$G(TIUDAT(1))
- I +$$ISADDNDM^TIULC1(TIUDAT) D G ABORT
- . W !!,$C(7),"You may not assign an addendum to an addendum...",!
- . W:$$READ^TIUU("EA","Press RETURN to continue...") ""
- . S TIUOUT=1
- D FROMTO^TIURD4(TIUDA,TIUDAT)
- I +$G(TIUDAT)>0,$$READ^TIUU("YO","Is this Correct","YES") D Q
- . N TIUDD0,TIUDD12,TIUDD14
- . S TIUDD0=$G(^TIU(8925,+TIUDAT,0)),TIUDD12=$G(^(12)),TIUDD14=$G(^(14))
- . S DR=".02////"_$P(TIUDD0,U,2)_";.03////"_$P(TIUDD0,U,3)_";.06////"_+TIUDAT_";.07////"_$P(TIUDD0,U,7)_";.08////"_$S(+$P(TIUDD0,U,8):$P(TIUDD0,U,8),1:"@")_";.13////"_$P(TIUDD0,U,13)
- . S DR=DR_";1401////"_$P(TIUDD14,U)_";1402////"_$P(TIUDD14,U,2)_";1404////"_$P(TIUDD14,U,4)_";1205////"_$P(TIUDD12,U,5)_";1211////"_$P(TIUDD12,U,11)_";1212////"_$P(TIUDD12,U,12)
- . S DIE=8925,DA=+TIUDA D ^DIE
- . K DR N TIUTYP
- . S DR=".05///"_$$STATUS^TIULC(+TIUDA) D ^DIE
- . S TIUD0(1)=$G(^TIU(8925,TIUDA,0)),TIUD12(1)=$G(^(12))
- . D AUDREASS^TIURB1(TIUDA,.TIUD0,.TIUD12)
- . I +$G(TIUODA) D AUDREASS^TIURB1(TIUODA,.TIUD0,.TIUD12)
- . D SEND^TIUALRT(TIUDA)
- . W "." S TIUCHNG=1
- ABORT ; Recover on abort
- W !!,"Okay...No Harm done!"
- I +$G(TIUODA),+$G(TIUDA),$D(TIUD0(0)) D RECOVER^TIURD4(TIUODA,TIUDA,.TIUD0)
- S TIUCHNG=0
- Q
- PROMOTE(TIUDA) ; Promote addendum
- N DA,DR,DIE,TIUADD0,TIUTYPE,TIUPTYPE,TIUOUT,TIUVTYPE,TIUODA
- S TIUADD0=$G(^TIU(8925,+TIUDA,0))
- S TIUTYPE=+$G(^TIU(8925,+$P(TIUADD0,U,6),0)),TIUPTYPE=$P($G(^(0)),U,4),TIUVTYPE=$P($G(^(0)),U,13)
- S DR=".01////"_TIUTYPE_";.04////"_TIUPTYPE_";.06///@;.13////"_TIUVTYPE
- S DA=+TIUDA,DIE=8925
- D ^DIE K DA,DR,DIE
- D REASSIGO^TIURD3
- I +$G(TIUOUT)>0 D Q
- . N DIE,DA,DR
- . I +$G(TIUODA),+$G(TIUDA),$D(TIUD0(0)) D RECOVER^TIURD4(TIUODA,TIUDA,.TIUD0)
- . W !!,"Restoring Addendum to original state..."
- . S DIE=8925,DA=$S(+$G(TIUODA):TIUODA,1:TIUDA)
- . S DR=".01////^S X=+TIUADD0;.04////^S X=$P(TIUADD0,U,4);.06////^S X=$P(TIUADD0,U,6)"
- . S DR=DR_";.07////^S X=$P(TIUADD0,U,7);.08////^S X=$S(+$P(TIUADD0,U,8):+$P(TIUADD0,U,8),1:""@"")"
- . D ^DIE
- ; If promotion successful & addendum retracted, reset 0-node of retracted record
- I +$G(TIUODA) D
- . N DIE,DA,DR
- . S DIE=8925,DA=TIUODA
- . S DR=".01////^S X=+TIUADD0;.04////^S X=$P(TIUADD0,U,4);.06////^S X=$P(TIUADD0,U,6)"
- . D ^DIE
- D SEND^TIUALRT(TIUDA)
- W !!,"ADDENDUM Promoted to be an ORIGINAL ",$$PNAME^TIULC1(TIUTYPE) H 2
- S TIUCHNG=1,VALMBCK="Q"
- Q
- REPLACE(TIUDA) ; Replace original with addendum
- N TIUODA,TIUCONT,TIUOS,TIUAS,TIUOODA,TIUOD0
- W !!,$C(7),"This is an IRREVERSIBLE action..."
- S TIUCONT=$$READ^TIUU("YA","Are you SURE you wish to continue? ","NO")
- I '+TIUCONT S TIUCHNG=0 W !,"No changes made." Q
- W !,"Okay, here we go then..."
- S TIUODA=+$P(^TIU(8925,TIUDA,0),U,6) Q:+TIUODA'>0
- S TIUOD0=$G(^TIU(8925,TIUODA,0))
- I +$P(TIUOD0,U,5)>5 D
- . W !!,"A RETRACTED copy of the signed ORIGINAL will be retained.",!
- . S TIUOODA=TIUODA,TIUODA=$$RETRACT^TIURD2(TIUODA,"",+$P(TIUOD0,U,5),"",1)
- ; Load Signature
- D LOADSB^TIURD4(TIUODA,TIUDA,.TIUOS,.TIUAS)
- ; Move non-WP flds from add to orig
- D SWAPFLDS(TIUODA,TIUDA,0)
- ; Move original into ^TIU(8925,+TIUODA,"TEMP")
- D BUFFER^TIUEDIU(TIUODA) W "."
- ; Replace ^TIU(8925,+TIUODA,"TEMP") w ^TIU(8925,+TIUDA,"TEXT")
- K ^TIU(8925,+TIUODA,"TEMP")
- M ^TIU(8925,+TIUODA,"TEMP")=^TIU(8925,+TIUDA,"TEXT") W "."
- ; File changes
- K ^TIU(8925,+TIUODA,"TEXT")
- D MERGTEXT^TIUEDI1(TIUODA) W "."
- K ^TIU(8925,+TIUODA,"TEMP")
- ; Swap signatures
- D SWAPSB^TIURD4(TIUODA,TIUDA,.TIUOS,.TIUAS)
- ; Update status of new original
- D UPDSTAT^TIURD4(TIUODA)
- ; Resend alerts
- D SEND^TIUALRT(TIUODA)
- ; Delete Addendum Record
- D DELETE^TIUEDIT(TIUDA,0,"",1) W "...Done."
- S TIUCHNG=2 S:+$G(TIUOODA) TIUCHNG=TIUCHNG_U_TIUODA
- Q
- SWAPADD(TIUDA) ; Swap addendum with original
- N TIUODA,TIUCONT K ^TMP("TIUSWAP",$J)
- N TIUOS,TIUAS
- W !!,$C(7),"Don't worry...This is a REVERSIBLE action."
- S TIUCONT=$$READ^TIUU("YA","Even so, are you SURE you wish to continue? ","NO")
- I '+TIUCONT S TIUCHNG=0 W !,"No changes made." Q
- W !,"Okay, you can always swap 'em back"
- S TIUODA=+$P(^TIU(8925,TIUDA,0),U,6) Q:+TIUODA'>0
- D LOADSB^TIURD4(TIUODA,TIUDA,.TIUOS,.TIUAS)
- ; Swap the non-WP flds
- D SWAPFLDS(TIUODA,TIUDA,1)
- ; Move original into ^TIU(8925,+TIUODA,"TEMP")
- D BUFFER^TIUEDIU(TIUODA) W "."
- ; Move ^TIU(8925,+TIUODA,"TEMP") into ^TMP("TIUSWAP",$J)
- M ^TMP("TIUSWAP",$J)=^TIU(8925,+TIUODA,"TEMP") W "."
- ; Replace ^TIU(8925,+TIUODA,"TEMP") with ^TIU(8925,+TIUDA,"TEXT")
- K ^TIU(8925,+TIUODA,"TEMP")
- M ^TIU(8925,+TIUODA,"TEMP")=^TIU(8925,+TIUDA,"TEXT") W "."
- ; File changes to orig
- K ^TIU(8925,+TIUODA,"TEXT")
- D MERGTEXT^TIUEDI1(TIUODA) W "."
- K ^TIU(8925,+TIUODA,"TEMP")
- ; Merge ^TMP("TIUSWAP",$J) into ^TIU(8925,+TIUDA,"TEMP")
- K ^TIU(8925,+TIUDA,"TEMP")
- M ^TIU(8925,+TIUDA,"TEMP")=^TMP("TIUSWAP",$J) W "."
- ; File changes to add
- K ^TIU(8925,+TIUDA,"TEXT")
- D MERGTEXT^TIUEDI1(TIUDA) W "."
- ; Swap signatures
- D SWAPSB^TIURD4(TIUODA,TIUDA,.TIUOS,.TIUAS)
- ; Update status of each record
- D UPDSTAT^TIURD4(TIUODA),UPDSTAT^TIURD4(TIUDA)
- ; Resend alerts
- D SEND^TIUALRT(TIUDA),SEND^TIUALRT(TIUODA)
- ; Clean up ^TIU(8925,+TIUDA,"TEMP" and ^TMP("TIUSWAP",$J)
- K ^TIU(8925,+TIUDA,"TEMP"),^TMP("TIUSWAP",$J) W "...Done." S TIUCHNG=1
- Q
- SWAPFLDS(TIUODA,TIUADA,SWAP) ; Move Identifier fields
- N DA,DR,DIE,TIUOD12,TIUAD12,TIUOD13,TIUAD13,TIUOD15,TIUAD15
- S TIUOD12=$G(^TIU(8925,TIUODA,12)),TIUOD13=$G(^(13)),TIUOD15=$G(^(15))
- S TIUAD12=$G(^TIU(8925,TIUADA,12)),TIUAD13=$G(^(13)),TIUAD15=$G(^(15))
- S DR="1201////"_$S(+TIUAD12>0:+TIUAD12,1:"@")_";1202////"_$P(TIUAD12,U,2)
- S DR=DR_";1204////"_$P(TIUAD12,U,4)_";1208////"_$S($P(TIUAD12,U,8)]"":$P(TIUAD12,U,8),1:"@")_";1209////"_$S($P(TIUAD12,U,9)]"":$P(TIUAD12,U,9),1:"@")
- S DA=TIUODA,DIE="^TIU(8925," D ^DIE K DR
- S DR="1302////"_$P(TIUAD13,U,2)_";1303////"_$P(TIUAD13,U,3)_";1304////"_$S($P(TIUAD13,U,4)]"":$P(TIUAD13,U,4),1:"@")
- S DR=DR_";1305////"_$S($P(TIUAD13,U,5)]"":$P(TIUAD13,U,5),1:"@")_";1306////"_$S($P(TIUAD13,U,6)]"":$P(TIUAD13,U,6),1:"@")_";1307////"_$S($P(TIUAD13,U,7)]"":$P(TIUAD13,U,7),1:"@")
- S DA=TIUODA,DIE="^TIU(8925," D ^DIE K DR
- S DR="1501////"_$S($P(TIUAD15,U)]"":$P(TIUAD15,U),1:"@")_";1502////"_$S($P(TIUAD15,U,2)]"":$P(TIUAD15,U,2),1:"@")
- S DR=DR_";1505////"_$S($P(TIUAD15,U,5)]"":$P(TIUAD15,U,5),1:"@")_";1506////"_$S($P(TIUAD15,U,6)]"":$P(TIUAD15,U,6),1:"@")
- S DA=TIUODA,DIE="^TIU(8925," D ^DIE K DR
- S DR="1507////"_$S($P(TIUAD15,U,7)]"":$P(TIUAD15,U,7),1:"@")_";1508////"_$S($P(TIUAD15,U,8)]"":$P(TIUAD15,U,8),1:"@")
- S DR=DR_";1511////"_$S($P(TIUAD15,U,11)]"":$P(TIUAD15,U,11),1:"@")_";1512////"_$S($P(TIUAD15,U,12)]"":$P(TIUAD15,U,12),1:"@")_";1513////"_$S($P(TIUAD15,U,13)]"":$P(TIUAD15,U,13),1:"@")
- S DA=TIUODA,DIE="^TIU(8925," D ^DIE K DR
- I '+$G(SWAP) Q
- S DR="1201////"_$S(+TIUOD12>0:+TIUOD12,1:"@")_";1202////"_$P(TIUOD12,U,2)
- S DR=DR_";1204////"_$P(TIUOD12,U,4)_";1208////"_$S($P(TIUOD12,U,8)]"":$P(TIUOD12,U,8),1:"@")_";1209////"_$S($P(TIUOD12,U,9)]"":$P(TIUOD12,U,9),1:"@")
- S DA=TIUADA,DIE="^TIU(8925," D ^DIE K DR
- S DR="1302////"_$P(TIUOD13,U,2)_";1303////"_$P(TIUOD13,U,3)_";1304////"_$S($P(TIUOD13,U,4)]"":$P(TIUOD13,U,4),1:"@")
- S DR=DR_";1305////"_$S($P(TIUOD13,U,5)]"":$P(TIUOD13,U,5),1:"@")_";1306////"_$S($P(TIUOD13,U,6)]"":$P(TIUOD13,U,6),1:"@")_";1307////"_$S($P(TIUOD13,U,7)]"":$P(TIUOD13,U,7),1:"@")
- S DA=TIUADA,DIE="^TIU(8925," D ^DIE K DR
- S DR="1501////"_$S($P(TIUOD15,U)]"":$P(TIUOD15,U),1:"@")_";1502////"_$S($P(TIUOD15,U,2)]"":$P(TIUOD15,U,2),1:"@")
- S DR=DR_";1505////"_$S($P(TIUOD15,U,5)]"":$P(TIUOD15,U,5),1:"@")_";1506////"_$S($P(TIUOD15,U,6)]"":$P(TIUOD15,U,6),1:"@")
- S DA=TIUADA,DIE="^TIU(8925," D ^DIE K DR
- S DR="1507////"_$S($P(TIUOD15,U,7)]"":$P(TIUOD15,U,7),1:"@")_";1508////"_$S($P(TIUOD15,U,8)]"":$P(TIUOD15,U,8),1:"@")
- S DR=DR_";1511////"_$S($P(TIUOD15,U,11)]"":$P(TIUOD15,U,11),1:"@")_";1512////"_$S($P(TIUOD15,U,12)]"":$P(TIUOD15,U,12),1:"@")_";1513////"_$S($P(TIUOD15,U,13)]"":$P(TIUOD15,U,13),1:"@")
- S DA=TIUADA,DIE="^TIU(8925," D ^DIE K DR
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIURD1 8977 printed Jan 18, 2025@03:46:17 Page 2
- TIURD1 ; SLC/JER - Reassign actions ;4/18/03
- +1 ;;1.0;TEXT INTEGRATION UTILITIES;**1,7,61,113**;Jun 20, 1997
- MOVEADD(TIUDA) ; Move an addendum to another document
- +1 NEW DFN,TIUDAT,TIUSCRN,TIUMOVE,TIUTYP,TIUODA
- +2 SET TIUTYP=$$CLINDOC^TIULC1(+$GET(^TIU(8925,+$PIECE($GET(^TIU(8925,+TIUDA,0)),U,6),0)))
- +3 IF +TIUTYP'>0
- SET TIUTYP=38
- +4 SET TIUTYP(1)="1^"_TIUTYP_U_$PIECE(^TIU(8925.1,+TIUTYP,0),U)
- +5 SET DFN=+$$PATIENT^TIULA
- +6 IF +DFN'>0
- Begin DoDot:1
- +7 WRITE !!,"No PATIENT Selected: Aborting Transaction, No Harm Done...",!
- +8 ; pause
- IF $$READ^TIUU("EA","Press RETURN to continue...")
- +9 SET TIUOUT=1
- End DoDot:1
- QUIT
- +10 ; --- If moving to different pt, keep retracted original ---
- +11 IF +$GET(DFN)'=$PIECE(TIUD0(0),U,2)
- IF (+$PIECE(TIUD0(0),U,5)>5)
- Begin DoDot:1
- +12 WRITE !,"Moving signed document to another Patient...A RETRACTED copy will be retained."
- +13 SET TIUODA=TIUDA
- SET TIUDA=+$$RETRACT^TIURD2(TIUDA)
- End DoDot:1
- +14 if +TIUDA'>0
- QUIT
- +15 DO SELPAT^TIULA2(.TIUDAT,TIUTYP,DFN)
- +16 IF +$GET(TIUDAT)'>0
- IF ($DATA(TIUDAT)'>9)
- SET TIUOUT=1
- GOTO ABORT
- +17 SET TIUDAT=+$GET(TIUDAT(1))
- +18 IF +$$ISADDNDM^TIULC1(TIUDAT)
- Begin DoDot:1
- +19 WRITE !!,$CHAR(7),"You may not assign an addendum to an addendum...",!
- +20 if $$READ^TIUU("EA","Press RETURN to continue...")
- WRITE ""
- +21 SET TIUOUT=1
- End DoDot:1
- GOTO ABORT
- +22 DO FROMTO^TIURD4(TIUDA,TIUDAT)
- +23 IF +$GET(TIUDAT)>0
- IF $$READ^TIUU("YO","Is this Correct","YES")
- Begin DoDot:1
- +24 NEW TIUDD0,TIUDD12,TIUDD14
- +25 SET TIUDD0=$GET(^TIU(8925,+TIUDAT,0))
- SET TIUDD12=$GET(^(12))
- SET TIUDD14=$GET(^(14))
- +26 SET DR=".02////"_$PIECE(TIUDD0,U,2)_";.03////"_$PIECE(TIUDD0,U,3)_";.06////"_+TIUDAT_";.07////"_$PIECE(TIUDD0,U,7)_";.08////"_$SELECT(+$PIECE(TIUDD0,U,8):$PIECE(TIUDD0,U,8),1:"@")_";.13////"_$PIECE(TIUDD0,U,13)
- +27 SET DR=DR_";1401////"_$PIECE(TIUDD14,U)_";1402////"_$PIECE(TIUDD14,U,2)_";1404////"_$PIECE(TIUDD14,U,4)_";1205////"_$PIECE(TIUDD12,U,5)_";1211////"_$PIECE(TIUDD12,U,11)_";1212////"_$PIECE(TIUDD12,U,12)
- +28 SET DIE=8925
- SET DA=+TIUDA
- DO ^DIE
- +29 KILL DR
- NEW TIUTYP
- +30 SET DR=".05///"_$$STATUS^TIULC(+TIUDA)
- DO ^DIE
- +31 SET TIUD0(1)=$GET(^TIU(8925,TIUDA,0))
- SET TIUD12(1)=$GET(^(12))
- +32 DO AUDREASS^TIURB1(TIUDA,.TIUD0,.TIUD12)
- +33 IF +$GET(TIUODA)
- DO AUDREASS^TIURB1(TIUODA,.TIUD0,.TIUD12)
- +34 DO SEND^TIUALRT(TIUDA)
- +35 WRITE "."
- SET TIUCHNG=1
- End DoDot:1
- QUIT
- ABORT ; Recover on abort
- +1 WRITE !!,"Okay...No Harm done!"
- +2 IF +$GET(TIUODA)
- IF +$GET(TIUDA)
- IF $DATA(TIUD0(0))
- DO RECOVER^TIURD4(TIUODA,TIUDA,.TIUD0)
- +3 SET TIUCHNG=0
- +4 QUIT
- PROMOTE(TIUDA) ; Promote addendum
- +1 NEW DA,DR,DIE,TIUADD0,TIUTYPE,TIUPTYPE,TIUOUT,TIUVTYPE,TIUODA
- +2 SET TIUADD0=$GET(^TIU(8925,+TIUDA,0))
- +3 SET TIUTYPE=+$GET(^TIU(8925,+$PIECE(TIUADD0,U,6),0))
- SET TIUPTYPE=$PIECE($GET(^(0)),U,4)
- SET TIUVTYPE=$PIECE($GET(^(0)),U,13)
- +4 SET DR=".01////"_TIUTYPE_";.04////"_TIUPTYPE_";.06///@;.13////"_TIUVTYPE
- +5 SET DA=+TIUDA
- SET DIE=8925
- +6 DO ^DIE
- KILL DA,DR,DIE
- +7 DO REASSIGO^TIURD3
- +8 IF +$GET(TIUOUT)>0
- Begin DoDot:1
- +9 NEW DIE,DA,DR
- +10 IF +$GET(TIUODA)
- IF +$GET(TIUDA)
- IF $DATA(TIUD0(0))
- DO RECOVER^TIURD4(TIUODA,TIUDA,.TIUD0)
- +11 WRITE !!,"Restoring Addendum to original state..."
- +12 SET DIE=8925
- SET DA=$SELECT(+$GET(TIUODA):TIUODA,1:TIUDA)
- +13 SET DR=".01////^S X=+TIUADD0;.04////^S X=$P(TIUADD0,U,4);.06////^S X=$P(TIUADD0,U,6)"
- +14 SET DR=DR_";.07////^S X=$P(TIUADD0,U,7);.08////^S X=$S(+$P(TIUADD0,U,8):+$P(TIUADD0,U,8),1:""@"")"
- +15 DO ^DIE
- End DoDot:1
- QUIT
- +16 ; If promotion successful & addendum retracted, reset 0-node of retracted record
- +17 IF +$GET(TIUODA)
- Begin DoDot:1
- +18 NEW DIE,DA,DR
- +19 SET DIE=8925
- SET DA=TIUODA
- +20 SET DR=".01////^S X=+TIUADD0;.04////^S X=$P(TIUADD0,U,4);.06////^S X=$P(TIUADD0,U,6)"
- +21 DO ^DIE
- End DoDot:1
- +22 DO SEND^TIUALRT(TIUDA)
- +23 WRITE !!,"ADDENDUM Promoted to be an ORIGINAL ",$$PNAME^TIULC1(TIUTYPE)
- HANG 2
- +24 SET TIUCHNG=1
- SET VALMBCK="Q"
- +25 QUIT
- REPLACE(TIUDA) ; Replace original with addendum
- +1 NEW TIUODA,TIUCONT,TIUOS,TIUAS,TIUOODA,TIUOD0
- +2 WRITE !!,$CHAR(7),"This is an IRREVERSIBLE action..."
- +3 SET TIUCONT=$$READ^TIUU("YA","Are you SURE you wish to continue? ","NO")
- +4 IF '+TIUCONT
- SET TIUCHNG=0
- WRITE !,"No changes made."
- QUIT
- +5 WRITE !,"Okay, here we go then..."
- +6 SET TIUODA=+$PIECE(^TIU(8925,TIUDA,0),U,6)
- if +TIUODA'>0
- QUIT
- +7 SET TIUOD0=$GET(^TIU(8925,TIUODA,0))
- +8 IF +$PIECE(TIUOD0,U,5)>5
- Begin DoDot:1
- +9 WRITE !!,"A RETRACTED copy of the signed ORIGINAL will be retained.",!
- +10 SET TIUOODA=TIUODA
- SET TIUODA=$$RETRACT^TIURD2(TIUODA,"",+$PIECE(TIUOD0,U,5),"",1)
- End DoDot:1
- +11 ; Load Signature
- +12 DO LOADSB^TIURD4(TIUODA,TIUDA,.TIUOS,.TIUAS)
- +13 ; Move non-WP flds from add to orig
- +14 DO SWAPFLDS(TIUODA,TIUDA,0)
- +15 ; Move original into ^TIU(8925,+TIUODA,"TEMP")
- +16 DO BUFFER^TIUEDIU(TIUODA)
- WRITE "."
- +17 ; Replace ^TIU(8925,+TIUODA,"TEMP") w ^TIU(8925,+TIUDA,"TEXT")
- +18 KILL ^TIU(8925,+TIUODA,"TEMP")
- +19 MERGE ^TIU(8925,+TIUODA,"TEMP")=^TIU(8925,+TIUDA,"TEXT")
- WRITE "."
- +20 ; File changes
- +21 KILL ^TIU(8925,+TIUODA,"TEXT")
- +22 DO MERGTEXT^TIUEDI1(TIUODA)
- WRITE "."
- +23 KILL ^TIU(8925,+TIUODA,"TEMP")
- +24 ; Swap signatures
- +25 DO SWAPSB^TIURD4(TIUODA,TIUDA,.TIUOS,.TIUAS)
- +26 ; Update status of new original
- +27 DO UPDSTAT^TIURD4(TIUODA)
- +28 ; Resend alerts
- +29 DO SEND^TIUALRT(TIUODA)
- +30 ; Delete Addendum Record
- +31 DO DELETE^TIUEDIT(TIUDA,0,"",1)
- WRITE "...Done."
- +32 SET TIUCHNG=2
- if +$GET(TIUOODA)
- SET TIUCHNG=TIUCHNG_U_TIUODA
- +33 QUIT
- SWAPADD(TIUDA) ; Swap addendum with original
- +1 NEW TIUODA,TIUCONT
- KILL ^TMP("TIUSWAP",$JOB)
- +2 NEW TIUOS,TIUAS
- +3 WRITE !!,$CHAR(7),"Don't worry...This is a REVERSIBLE action."
- +4 SET TIUCONT=$$READ^TIUU("YA","Even so, are you SURE you wish to continue? ","NO")
- +5 IF '+TIUCONT
- SET TIUCHNG=0
- WRITE !,"No changes made."
- QUIT
- +6 WRITE !,"Okay, you can always swap 'em back"
- +7 SET TIUODA=+$PIECE(^TIU(8925,TIUDA,0),U,6)
- if +TIUODA'>0
- QUIT
- +8 DO LOADSB^TIURD4(TIUODA,TIUDA,.TIUOS,.TIUAS)
- +9 ; Swap the non-WP flds
- +10 DO SWAPFLDS(TIUODA,TIUDA,1)
- +11 ; Move original into ^TIU(8925,+TIUODA,"TEMP")
- +12 DO BUFFER^TIUEDIU(TIUODA)
- WRITE "."
- +13 ; Move ^TIU(8925,+TIUODA,"TEMP") into ^TMP("TIUSWAP",$J)
- +14 MERGE ^TMP("TIUSWAP",$JOB)=^TIU(8925,+TIUODA,"TEMP")
- WRITE "."
- +15 ; Replace ^TIU(8925,+TIUODA,"TEMP") with ^TIU(8925,+TIUDA,"TEXT")
- +16 KILL ^TIU(8925,+TIUODA,"TEMP")
- +17 MERGE ^TIU(8925,+TIUODA,"TEMP")=^TIU(8925,+TIUDA,"TEXT")
- WRITE "."
- +18 ; File changes to orig
- +19 KILL ^TIU(8925,+TIUODA,"TEXT")
- +20 DO MERGTEXT^TIUEDI1(TIUODA)
- WRITE "."
- +21 KILL ^TIU(8925,+TIUODA,"TEMP")
- +22 ; Merge ^TMP("TIUSWAP",$J) into ^TIU(8925,+TIUDA,"TEMP")
- +23 KILL ^TIU(8925,+TIUDA,"TEMP")
- +24 MERGE ^TIU(8925,+TIUDA,"TEMP")=^TMP("TIUSWAP",$JOB)
- WRITE "."
- +25 ; File changes to add
- +26 KILL ^TIU(8925,+TIUDA,"TEXT")
- +27 DO MERGTEXT^TIUEDI1(TIUDA)
- WRITE "."
- +28 ; Swap signatures
- +29 DO SWAPSB^TIURD4(TIUODA,TIUDA,.TIUOS,.TIUAS)
- +30 ; Update status of each record
- +31 DO UPDSTAT^TIURD4(TIUODA)
- DO UPDSTAT^TIURD4(TIUDA)
- +32 ; Resend alerts
- +33 DO SEND^TIUALRT(TIUDA)
- DO SEND^TIUALRT(TIUODA)
- +34 ; Clean up ^TIU(8925,+TIUDA,"TEMP" and ^TMP("TIUSWAP",$J)
- +35 KILL ^TIU(8925,+TIUDA,"TEMP"),^TMP("TIUSWAP",$JOB)
- WRITE "...Done."
- SET TIUCHNG=1
- +36 QUIT
- SWAPFLDS(TIUODA,TIUADA,SWAP) ; Move Identifier fields
- +1 NEW DA,DR,DIE,TIUOD12,TIUAD12,TIUOD13,TIUAD13,TIUOD15,TIUAD15
- +2 SET TIUOD12=$GET(^TIU(8925,TIUODA,12))
- SET TIUOD13=$GET(^(13))
- SET TIUOD15=$GET(^(15))
- +3 SET TIUAD12=$GET(^TIU(8925,TIUADA,12))
- SET TIUAD13=$GET(^(13))
- SET TIUAD15=$GET(^(15))
- +4 SET DR="1201////"_$SELECT(+TIUAD12>0:+TIUAD12,1:"@")_";1202////"_$PIECE(TIUAD12,U,2)
- +5 SET DR=DR_";1204////"_$PIECE(TIUAD12,U,4)_";1208////"_$SELECT($PIECE(TIUAD12,U,8)]"":$PIECE(TIUAD12,U,8),1:"@")_";1209////"_$SELECT($PIECE(TIUAD12,U,9)]"":$PIECE(TIUAD12,U,9),1:"@")
- +6 SET DA=TIUODA
- SET DIE="^TIU(8925,"
- DO ^DIE
- KILL DR
- +7 SET DR="1302////"_$PIECE(TIUAD13,U,2)_";1303////"_$PIECE(TIUAD13,U,3)_";1304////"_$SELECT($PIECE(TIUAD13,U,4)]"":$PIECE(TIUAD13,U,4),1:"@")
- +8 SET DR=DR_";1305////"_$SELECT($PIECE(TIUAD13,U,5)]"":$PIECE(TIUAD13,U,5),1:"@")_";1306////"_$SELECT($PIECE(TIUAD13,U,6)]"":$PIECE(TIUAD13,U,6),1:"@")_";1307////"_$SELECT($PIECE(TIUAD13,U,7)]"":$PIECE(TIUAD13,U,7),1:"@")
- +9 SET DA=TIUODA
- SET DIE="^TIU(8925,"
- DO ^DIE
- KILL DR
- +10 SET DR="1501////"_$SELECT($PIECE(TIUAD15,U)]"":$PIECE(TIUAD15,U),1:"@")_";1502////"_$SELECT($PIECE(TIUAD15,U,2)]"":$PIECE(TIUAD15,U,2),1:"@")
- +11 SET DR=DR_";1505////"_$SELECT($PIECE(TIUAD15,U,5)]"":$PIECE(TIUAD15,U,5),1:"@")_";1506////"_$SELECT($PIECE(TIUAD15,U,6)]"":$PIECE(TIUAD15,U,6),1:"@")
- +12 SET DA=TIUODA
- SET DIE="^TIU(8925,"
- DO ^DIE
- KILL DR
- +13 SET DR="1507////"_$SELECT($PIECE(TIUAD15,U,7)]"":$PIECE(TIUAD15,U,7),1:"@")_";1508////"_$SELECT($PIECE(TIUAD15,U,8)]"":$PIECE(TIUAD15,U,8),1:"@")
- +14 SET DR=DR_";1511////"_$SELECT($PIECE(TIUAD15,U,11)]"":$PIECE(TIUAD15,U,11),1:"@")_";1512////"_$SELECT($PIECE(TIUAD15,U,12)]"":$PIECE(TIUAD15,U,12),1:"@")_";1513////"_$SELECT($PIECE(TIUAD15,U,13)]"":$PIECE(TIUAD15,U,13),1:"@")
- +15 SET DA=TIUODA
- SET DIE="^TIU(8925,"
- DO ^DIE
- KILL DR
- +16 IF '+$GET(SWAP)
- QUIT
- +17 SET DR="1201////"_$SELECT(+TIUOD12>0:+TIUOD12,1:"@")_";1202////"_$PIECE(TIUOD12,U,2)
- +18 SET DR=DR_";1204////"_$PIECE(TIUOD12,U,4)_";1208////"_$SELECT($PIECE(TIUOD12,U,8)]"":$PIECE(TIUOD12,U,8),1:"@")_";1209////"_$SELECT($PIECE(TIUOD12,U,9)]"":$PIECE(TIUOD12,U,9),1:"@")
- +19 SET DA=TIUADA
- SET DIE="^TIU(8925,"
- DO ^DIE
- KILL DR
- +20 SET DR="1302////"_$PIECE(TIUOD13,U,2)_";1303////"_$PIECE(TIUOD13,U,3)_";1304////"_$SELECT($PIECE(TIUOD13,U,4)]"":$PIECE(TIUOD13,U,4),1:"@")
- +21 SET DR=DR_";1305////"_$SELECT($PIECE(TIUOD13,U,5)]"":$PIECE(TIUOD13,U,5),1:"@")_";1306////"_$SELECT($PIECE(TIUOD13,U,6)]"":$PIECE(TIUOD13,U,6),1:"@")_";1307////"_$SELECT($PIECE(TIUOD13,U,7)]"":$PIECE(TIUOD13,U,7),1:"@")
- +22 SET DA=TIUADA
- SET DIE="^TIU(8925,"
- DO ^DIE
- KILL DR
- +23 SET DR="1501////"_$SELECT($PIECE(TIUOD15,U)]"":$PIECE(TIUOD15,U),1:"@")_";1502////"_$SELECT($PIECE(TIUOD15,U,2)]"":$PIECE(TIUOD15,U,2),1:"@")
- +24 SET DR=DR_";1505////"_$SELECT($PIECE(TIUOD15,U,5)]"":$PIECE(TIUOD15,U,5),1:"@")_";1506////"_$SELECT($PIECE(TIUOD15,U,6)]"":$PIECE(TIUOD15,U,6),1:"@")
- +25 SET DA=TIUADA
- SET DIE="^TIU(8925,"
- DO ^DIE
- KILL DR
- +26 SET DR="1507////"_$SELECT($PIECE(TIUOD15,U,7)]"":$PIECE(TIUOD15,U,7),1:"@")_";1508////"_$SELECT($PIECE(TIUOD15,U,8)]"":$PIECE(TIUOD15,U,8),1:"@")
- +27 SET DR=DR_";1511////"_$SELECT($PIECE(TIUOD15,U,11)]"":$PIECE(TIUOD15,U,11),1:"@")_";1512////"_$SELECT($PIECE(TIUOD15,U,12)]"":$PIECE(TIUOD15,U,12),1:"@")_";1513////"_$SELECT($PIECE(TIUOD15,U,13)]"":$PIECE(TIUOD15,U,13),1:"@")
- +28 SET DA=TIUADA
- SET DIE="^TIU(8925,"
- DO ^DIE
- KILL DR
- +29 QUIT