TIURC1 ; SLC/JER - Additional Review screen actions ;4/13/05
;;1.0;TEXT INTEGRATION UTILITIES;**100,113,184**;Jun 20, 1997
COPY ; Copy
N DA,DIE,DR,TIU,TIUCHNG,TIUDATA,TIUI,TIUY,Y,DIROUT
N TIUVIEW,TIULST,TIUNREC,TIUDAARY,OLDNREC
I '$D(VALMY) D EN^VALM2(XQORNOD(0))
S TIUI=0
F S TIUI=$O(VALMY(TIUI)) Q:+TIUI'>0 D Q:$D(DIROUT)
. N TIU,RSTRCTD
. S TIUDATA=$G(^TMP("TIURIDX",$J,TIUI))
. S TIUDA=+$P(TIUDATA,U,2) S RSTRCTD=$$DOCRES^TIULRR(TIUDA)
. I RSTRCTD D Q
. . W !!,$C(7),"Ok, no harm done...",!
. . I $$READ^TIUU("EA","RETURN to continue...") ; pause
. S TIUVIEW=$$CANDO^TIULP(TIUDA,"VIEW")
. I +TIUVIEW'>0 D Q
. . W !!,$C(7),$P(TIUVIEW,U,2),!
. . I $$READ^TIUU("EA","RETURN to continue...") ; pause
. S OLDNREC=$G(TIUNREC)
. ; -- Single docmt copy. Does COPY1.
. ; Generates list TIUNREC of new recs for feedback
. D EN^VALM("TIU COPY DOCUMENT")
. K ^TMP("TIUVIEW",$J)
. I $G(TIUNREC)'=OLDNREC D
. . S TIUDAARY(TIUI)=TIUDA
. . S TIULST=$G(TIULST)_$S($G(TIULST)]"":",",1:"")_TIUI
I +$G(TIUNREC) D
. N TIUI,TIUNDA,TIUITEM
. F TIUI=1:1:$L($G(TIUNREC),",") D
. . S TIUNDA=$P(TIUNREC,",",TIUI),TIUITEM=+$G(^TMP("TIUR",$J,0))
. . D ADDELMNT^TIUR2(TIUNDA,+TIUITEM,1)
S TIUCHNG("REFRESH")=1
D UPRBLD^TIURL(.TIUCHNG,.VALMY) K VALMY
S VALMBCK="R"
D VMSG^TIURS1($G(TIULST),.TIUDAARY,"copied")
Q
COPY1 ; Copy a document
N TIUOD0,TIUOD12,TIUD13,TIUOD14,TIUOD17,TIUI,TIUPAT,TIUTNM,TIUTYP
N TIUDPRM,TIUPOP,TIUCOPY,TIUVSUPP,DUOUT,DIROUT,DTOUT,TIUASK
S TIUPOP=0
I +$$ISADDNDM^TIULC1(TIUDA) D Q
. W !,$C(7),"ADDENDA may not be copied."
. I $$READ^TIUU("EA","Press RETURN to continue...") W ""
S TIUCOPY=$$CANDO^TIULP(TIUDA,"COPY RECORD")
I +TIUCOPY'>0 D Q
. W !!,$C(7),$P(TIUCOPY,U,2),!
. I $$READ^TIUU("EA","RETURN to continue...") ; pause
S TIUOD0=$G(^TIU(8925,+TIUDA,0)),TIUOD12=$G(^(12)),TIUD13=$G(^(13))
S TIUOD14=$G(^TIU(8925,+TIUDA,14)),TIUOD17=$G(^TIU(8925,+TIUDA,17))
S TIUTYP=+TIUOD0
D FULL^VALM1
I $$CHKTITLE(+TIUTYP) D Q:$G(TIUOUT)=1
. N TIUDOC0,TIUDCLS
. S TIUDOC0=$G(^TIU(8925.1,TIUTYP,0))
. W !
. I $P(TIUDOC0,U,7)=13 D
. . W !,$C(7),$P(TIUDOC0,U,3)," is an inactive title."
. W !,"You must now select a new, active title BEFORE the note is copied:",!
. S TIUDCLS=+$$CLINDOC^TIULC1(+TIUTYP,TIUDA),TIUTYP=0
. D DOCSPICK^TIULA2(.TIUTYP,TIUDCLS,"1A","","","+$$CANPICK^TIULP(+Y),+$$CANENTR^TIULP(+Y)")
. I TIUTYP'>0 S TIUOUT=1
. E D
. . S TIUTYP=$P($G(TIUTYP(1)),U,2)
. . I $$CHKTITLE(+TIUTYP) S TIUOUT=1
D DOCPRM^TIULC1(TIUTYP,.TIUDPRM,TIUDA)
S TIUTNM=$$PNAME^TIULC1(+TIUTYP)
S TIUTYP(1)="1^"_+TIUTYP_U_TIUTNM_U
W !!,"Please Choose One or More Patients for whom the document should be copied:",!
F D Q:+TIUPOP
. D PATIENT^ORU1(.TIUPAT,1)
. I +TIUPAT'>0 D Q
. . W !,$C(7),"No patient(s) selected..."
. . I $$READ^TIUU("EA","Press RETURN to continue...") W !
. . S TIUCHNG=0,TIUPOP=1
. S TIUI=0 F S TIUI=$O(TIUPAT(TIUI)) Q:+TIUI'>0 D
. . N DA,DR,DFN,TIU,TIULMETH,TIUVMETH,TIUPATNM
. . S DFN=+TIUPAT(TIUI),TIUPATNM=$P(TIUPAT(TIUI),U,2)
. . S TIUVSUPP=+$$SUPPVSIT^TIULC1(TIUTYP)
. . I TIUVSUPP'>0 D I 1
. . . S TIULMETH=$$GETLMETH^TIUEDI1(TIUTYP)
. . . I '$L(TIULMETH) D S TIUOUT=1 Q
. . . . W !,$C(7),"No Visit Linkage Method defined for "
. . . . W $$PNAME^TIULC1(TIUTYP),".",!,"Please contact IRM..."
. . . . I $$READ^TIUU("EA","Press RETURN to continue...") W ""
. . . W !!,"For Patient ",TIUPATNM
. . . X TIULMETH
. . E D EVENT^TIUSRVP1(.TIU,DFN)
. . I '$D(TIU("VSTR")) W !,$C(7),"Patient & Visit required." H 2 Q
. . S TIUVMETH=$$GETVMETH^TIUEDI1(TIUTYP)
. . I '$L(TIUVMETH) D S TIUOUT=1 Q
. . . W !,$C(7),"No Validation Method defined for "
. . . W $$PNAME^TIULC1(TIUTYP),".",!,"Please contact IRM..."
. . X TIUVMETH
. . I $D(TIU),+$G(TIUASK) D
. . . N TIUNEW,TIUITEM,DA,DR,DIE
. . . S DA=$$GETRECNW^TIUEDI3(DFN,.TIU,TIUTYP(1),.TIUNEW,.TIUDPRM) Q:+DA'>0
. . . I '+$G(TIUNEW) D Q
. . . . W !!,$C(7),"A ",$P(TIUTYP(1),U,3)," already exists for this visit."
. . . . W !,"You may not use the copy function to overwrite an existing ",!,$$UPPER^TIULS($$STATUS^TIULC(DA))," ",$P(TIUTYP(1),U,3),".",!
. . . . I $$READ^TIUU("EA","Press RETURN to continue...") W ""
. . . D COPY0(DA,TIUOD0,.TIU),COPY12(DA,TIUOD0,TIUOD12,.TIU),COPY13(DA,TIUD13)
. . . D COPY14(DA,TIUOD14,.TIU),COPY17(DA,TIUOD17),COPYTEXT(TIUDA,DA)
. . . I $D(^TIU(8925,DA,"TEMP")) D MERGTEXT^TIUEDI1(DA,.TIU) K ^TIU(8925,+DA,"TEMP")
. . . S DR=".05///"_$$UPPER^TIULS($$STATUS^TIULC(DA)),DIE=8925 D ^DIE
. . . I +$D(^TIU(8925,+DA,"TEXT"))>9!(+$O(^TIU(8925,"DAD",+DA,0))>0) D
. . . . N TIUDA,TIUCPYNG S TIUDA=+DA,TIUCPYNG=1 D EDIT1^TIURA
. . . I '$G(DA) Q ;Docmt deleted in TIURA
. . . S TIUCHNG=1,TIUNREC=$G(TIUNREC)_$S(+$G(TIUNREC):",",1:"")_DA
. S TIUPOP='+$$AGAIN
Q
CHKTITLE(TIUTYP) ; Title Status
N TIUBAD S TIUBAD=0
I +$$CANPICK^TIULP(+TIUTYP)'>0 S TIUBAD=1 I 1
E I +$$CANENTR^TIULP(+TIUTYP)'>0 S TIUBAD=1
Q TIUBAD
AGAIN() ; Ask again?
N TIUY W !
S TIUY=$$READ^TIUU("Y","Copy this note again","No")
Q TIUY
COPY0(DA,TIUD0,TIU) ; Copy 0-node
N DR,DIE S DIE=8925
S DR=".02////"_DFN_";.03////"_$P($G(TIU("VISIT")),U)_";.04////"_$P(TIUD0,U,4)_";.07////"_$P($G(TIU("EDT")),U)_";.08////"_$P($G(TIU("LDT")),U)_";.09////"_$P(TIUD0,U,9)
I $P($G(TIUDPRM(0)),U,16),'$P($G(^TIU(8925,+DA,0)),U,11),$$WORKOK^TIUPXAP1(+DA) S DR=DR_";.11////1" ;set flag to collect workload
D ^DIE
Q
COPY12(DA,TIUD0,TIUD12,TIU) ; Copy 12-node
N DR,DIE S DIE=8925
S DR="1201////"_$$NOW^TIULC_";1202////"_+$G(DUZ)_";1203////"_$P(TIUD12,U,3)_";1204////"_$G(DUZ)_";1205////"_$P($G(TIU("LOC")),U)
S DR=DR_";1206////"_$P(TIUD12,U,6)_";1207////"_$P(TIUD12,U,7)_";1209////"_$P(TIUD12,U,9)
I +$$REQCOSIG^TIULP(+TIUD0,DA,+$G(DUZ)) S DR=DR_";1208////"_$P(TIUD12,U,8)
S DR=DR_";1210////"_$P(TIUD12,U,10)_";1211////"_+$G(TIU("VLOC"))_";1212////"_$P($G(TIU("INST")),U)
D ^DIE
Q
COPY13(DA,TIUD13,TIU) ; Copy 13-node
N DR,DIE S DIE=8925
S DR="1301////"_$$NOW^TIULC_";1302////"_$G(DUZ)_";1303////O;1307////"_$P(TIUD13,U,7)
D ^DIE
Q
COPY14(DA,TIUD14,TIU) ; Copy 14-node
N DR,DIE S DIE=8925
S DR="1401////"_$P($G(TIU("AD#")),U)_";1402////"_$P($G(TIU("TS")),U)_";1403////"_$P(TIUD14,U,3)_";1404////"_$P(TIUD14,U,4)
D ^DIE
Q
COPY17(DA,TIUD17) ; Copy Subject
N DR,DIE S DIE=8925
I $G(TIUD17)']"" Q
S DR="1701////^S X=$G(TIUD17)" D ^DIE
Q
COPYTEXT(TIUDA,DA) ; Copy text
N TIUC,TIUI,TIUJ,TIULINE
I +$O(^TIU(8925,+TIUDA,"TEXT",0)) M ^TIU(8925,+DA,"TEMP")=^TIU(8925,+TIUDA,"TEXT")
S (TIUC,TIULINE)=0,TIUJ=+$P($G(^TIU(8925,+DA,"TEMP",0)),U,3)
F S TIUC=$O(^TIU(8925,"DAD",TIUDA,TIUC)) Q:+TIUC'>0 D
. I +$$ISADDNDM^TIULC1(TIUC) Q
. S TIUI=0 F S TIUI=$O(^TIU(8925,+TIUC,"TEXT",TIUI)) Q:+TIUI'>0 D
. . S TIUJ=+$G(TIUJ)+1
. . S ^TIU(8925,+DA,"TEMP",TIUJ,0)=$G(^TIU(8925,+TIUC,"TEXT",TIUI,0))
. . S ^TIU(8925,+DA,"TEMP",0)="^^"_TIUJ_"^"_TIUJ_"^"_DT_"^^"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIURC1 6984 printed Dec 13, 2024@02:45:06 Page 2
TIURC1 ; SLC/JER - Additional Review screen actions ;4/13/05
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**100,113,184**;Jun 20, 1997
COPY ; Copy
+1 NEW DA,DIE,DR,TIU,TIUCHNG,TIUDATA,TIUI,TIUY,Y,DIROUT
+2 NEW TIUVIEW,TIULST,TIUNREC,TIUDAARY,OLDNREC
+3 IF '$DATA(VALMY)
DO EN^VALM2(XQORNOD(0))
+4 SET TIUI=0
+5 FOR
SET TIUI=$ORDER(VALMY(TIUI))
if +TIUI'>0
QUIT
Begin DoDot:1
+6 NEW TIU,RSTRCTD
+7 SET TIUDATA=$GET(^TMP("TIURIDX",$JOB,TIUI))
+8 SET TIUDA=+$PIECE(TIUDATA,U,2)
SET RSTRCTD=$$DOCRES^TIULRR(TIUDA)
+9 IF RSTRCTD
Begin DoDot:2
+10 WRITE !!,$CHAR(7),"Ok, no harm done...",!
+11 ; pause
IF $$READ^TIUU("EA","RETURN to continue...")
End DoDot:2
QUIT
+12 SET TIUVIEW=$$CANDO^TIULP(TIUDA,"VIEW")
+13 IF +TIUVIEW'>0
Begin DoDot:2
+14 WRITE !!,$CHAR(7),$PIECE(TIUVIEW,U,2),!
+15 ; pause
IF $$READ^TIUU("EA","RETURN to continue...")
End DoDot:2
QUIT
+16 SET OLDNREC=$GET(TIUNREC)
+17 ; -- Single docmt copy. Does COPY1.
+18 ; Generates list TIUNREC of new recs for feedback
+19 DO EN^VALM("TIU COPY DOCUMENT")
+20 KILL ^TMP("TIUVIEW",$JOB)
+21 IF $GET(TIUNREC)'=OLDNREC
Begin DoDot:2
+22 SET TIUDAARY(TIUI)=TIUDA
+23 SET TIULST=$GET(TIULST)_$SELECT($GET(TIULST)]"":",",1:"")_TIUI
End DoDot:2
End DoDot:1
if $DATA(DIROUT)
QUIT
+24 IF +$GET(TIUNREC)
Begin DoDot:1
+25 NEW TIUI,TIUNDA,TIUITEM
+26 FOR TIUI=1:1:$LENGTH($GET(TIUNREC),",")
Begin DoDot:2
+27 SET TIUNDA=$PIECE(TIUNREC,",",TIUI)
SET TIUITEM=+$GET(^TMP("TIUR",$JOB,0))
+28 DO ADDELMNT^TIUR2(TIUNDA,+TIUITEM,1)
End DoDot:2
End DoDot:1
+29 SET TIUCHNG("REFRESH")=1
+30 DO UPRBLD^TIURL(.TIUCHNG,.VALMY)
KILL VALMY
+31 SET VALMBCK="R"
+32 DO VMSG^TIURS1($GET(TIULST),.TIUDAARY,"copied")
+33 QUIT
COPY1 ; Copy a document
+1 NEW TIUOD0,TIUOD12,TIUD13,TIUOD14,TIUOD17,TIUI,TIUPAT,TIUTNM,TIUTYP
+2 NEW TIUDPRM,TIUPOP,TIUCOPY,TIUVSUPP,DUOUT,DIROUT,DTOUT,TIUASK
+3 SET TIUPOP=0
+4 IF +$$ISADDNDM^TIULC1(TIUDA)
Begin DoDot:1
+5 WRITE !,$CHAR(7),"ADDENDA may not be copied."
+6 IF $$READ^TIUU("EA","Press RETURN to continue...")
WRITE ""
End DoDot:1
QUIT
+7 SET TIUCOPY=$$CANDO^TIULP(TIUDA,"COPY RECORD")
+8 IF +TIUCOPY'>0
Begin DoDot:1
+9 WRITE !!,$CHAR(7),$PIECE(TIUCOPY,U,2),!
+10 ; pause
IF $$READ^TIUU("EA","RETURN to continue...")
End DoDot:1
QUIT
+11 SET TIUOD0=$GET(^TIU(8925,+TIUDA,0))
SET TIUOD12=$GET(^(12))
SET TIUD13=$GET(^(13))
+12 SET TIUOD14=$GET(^TIU(8925,+TIUDA,14))
SET TIUOD17=$GET(^TIU(8925,+TIUDA,17))
+13 SET TIUTYP=+TIUOD0
+14 DO FULL^VALM1
+15 IF $$CHKTITLE(+TIUTYP)
Begin DoDot:1
+16 NEW TIUDOC0,TIUDCLS
+17 SET TIUDOC0=$GET(^TIU(8925.1,TIUTYP,0))
+18 WRITE !
+19 IF $PIECE(TIUDOC0,U,7)=13
Begin DoDot:2
+20 WRITE !,$CHAR(7),$PIECE(TIUDOC0,U,3)," is an inactive title."
End DoDot:2
+21 WRITE !,"You must now select a new, active title BEFORE the note is copied:",!
+22 SET TIUDCLS=+$$CLINDOC^TIULC1(+TIUTYP,TIUDA)
SET TIUTYP=0
+23 DO DOCSPICK^TIULA2(.TIUTYP,TIUDCLS,"1A","","","+$$CANPICK^TIULP(+Y),+$$CANENTR^TIULP(+Y)")
+24 IF TIUTYP'>0
SET TIUOUT=1
+25 IF '$TEST
Begin DoDot:2
+26 SET TIUTYP=$PIECE($GET(TIUTYP(1)),U,2)
+27 IF $$CHKTITLE(+TIUTYP)
SET TIUOUT=1
End DoDot:2
End DoDot:1
if $GET(TIUOUT)=1
QUIT
+28 DO DOCPRM^TIULC1(TIUTYP,.TIUDPRM,TIUDA)
+29 SET TIUTNM=$$PNAME^TIULC1(+TIUTYP)
+30 SET TIUTYP(1)="1^"_+TIUTYP_U_TIUTNM_U
+31 WRITE !!,"Please Choose One or More Patients for whom the document should be copied:",!
+32 FOR
Begin DoDot:1
+33 DO PATIENT^ORU1(.TIUPAT,1)
+34 IF +TIUPAT'>0
Begin DoDot:2
+35 WRITE !,$CHAR(7),"No patient(s) selected..."
+36 IF $$READ^TIUU("EA","Press RETURN to continue...")
WRITE !
+37 SET TIUCHNG=0
SET TIUPOP=1
End DoDot:2
QUIT
+38 SET TIUI=0
FOR
SET TIUI=$ORDER(TIUPAT(TIUI))
if +TIUI'>0
QUIT
Begin DoDot:2
+39 NEW DA,DR,DFN,TIU,TIULMETH,TIUVMETH,TIUPATNM
+40 SET DFN=+TIUPAT(TIUI)
SET TIUPATNM=$PIECE(TIUPAT(TIUI),U,2)
+41 SET TIUVSUPP=+$$SUPPVSIT^TIULC1(TIUTYP)
+42 IF TIUVSUPP'>0
Begin DoDot:3
+43 SET TIULMETH=$$GETLMETH^TIUEDI1(TIUTYP)
+44 IF '$LENGTH(TIULMETH)
Begin DoDot:4
+45 WRITE !,$CHAR(7),"No Visit Linkage Method defined for "
+46 WRITE $$PNAME^TIULC1(TIUTYP),".",!,"Please contact IRM..."
+47 IF $$READ^TIUU("EA","Press RETURN to continue...")
WRITE ""
End DoDot:4
SET TIUOUT=1
QUIT
+48 WRITE !!,"For Patient ",TIUPATNM
+49 XECUTE TIULMETH
End DoDot:3
IF 1
+50 IF '$TEST
DO EVENT^TIUSRVP1(.TIU,DFN)
+51 IF '$DATA(TIU("VSTR"))
WRITE !,$CHAR(7),"Patient & Visit required."
HANG 2
QUIT
+52 SET TIUVMETH=$$GETVMETH^TIUEDI1(TIUTYP)
+53 IF '$LENGTH(TIUVMETH)
Begin DoDot:3
+54 WRITE !,$CHAR(7),"No Validation Method defined for "
+55 WRITE $$PNAME^TIULC1(TIUTYP),".",!,"Please contact IRM..."
End DoDot:3
SET TIUOUT=1
QUIT
+56 XECUTE TIUVMETH
+57 IF $DATA(TIU)
IF +$GET(TIUASK)
Begin DoDot:3
+58 NEW TIUNEW,TIUITEM,DA,DR,DIE
+59 SET DA=$$GETRECNW^TIUEDI3(DFN,.TIU,TIUTYP(1),.TIUNEW,.TIUDPRM)
if +DA'>0
QUIT
+60 IF '+$GET(TIUNEW)
Begin DoDot:4
+61 WRITE !!,$CHAR(7),"A ",$PIECE(TIUTYP(1),U,3)," already exists for this visit."
+62 WRITE !,"You may not use the copy function to overwrite an existing ",!,$$UPPER^TIULS($$STATUS^TIULC(DA))," ",$PIECE(TIUTYP(1),U,3),".",!
+63 IF $$READ^TIUU("EA","Press RETURN to continue...")
WRITE ""
End DoDot:4
QUIT
+64 DO COPY0(DA,TIUOD0,.TIU)
DO COPY12(DA,TIUOD0,TIUOD12,.TIU)
DO COPY13(DA,TIUD13)
+65 DO COPY14(DA,TIUOD14,.TIU)
DO COPY17(DA,TIUOD17)
DO COPYTEXT(TIUDA,DA)
+66 IF $DATA(^TIU(8925,DA,"TEMP"))
DO MERGTEXT^TIUEDI1(DA,.TIU)
KILL ^TIU(8925,+DA,"TEMP")
+67 SET DR=".05///"_$$UPPER^TIULS($$STATUS^TIULC(DA))
SET DIE=8925
DO ^DIE
+68 IF +$DATA(^TIU(8925,+DA,"TEXT"))>9!(+$ORDER(^TIU(8925,"DAD",+DA,0))>0)
Begin DoDot:4
+69 NEW TIUDA,TIUCPYNG
SET TIUDA=+DA
SET TIUCPYNG=1
DO EDIT1^TIURA
End DoDot:4
+70 ;Docmt deleted in TIURA
IF '$GET(DA)
QUIT
+71 SET TIUCHNG=1
SET TIUNREC=$GET(TIUNREC)_$SELECT(+$GET(TIUNREC):",",1:"")_DA
End DoDot:3
End DoDot:2
+72 SET TIUPOP='+$$AGAIN
End DoDot:1
if +TIUPOP
QUIT
+73 QUIT
CHKTITLE(TIUTYP) ; Title Status
+1 NEW TIUBAD
SET TIUBAD=0
+2 IF +$$CANPICK^TIULP(+TIUTYP)'>0
SET TIUBAD=1
IF 1
+3 IF '$TEST
IF +$$CANENTR^TIULP(+TIUTYP)'>0
SET TIUBAD=1
+4 QUIT TIUBAD
AGAIN() ; Ask again?
+1 NEW TIUY
WRITE !
+2 SET TIUY=$$READ^TIUU("Y","Copy this note again","No")
+3 QUIT TIUY
COPY0(DA,TIUD0,TIU) ; Copy 0-node
+1 NEW DR,DIE
SET DIE=8925
+2 SET DR=".02////"_DFN_";.03////"_$PIECE($GET(TIU("VISIT")),U)_";.04////"_$PIECE(TIUD0,U,4)_";.07////"_$PIECE($GET(TIU("EDT")),U)_";.08////"_$PIECE($GET(TIU("LDT")),U)_";.09////"_$PIECE(TIUD0,U,9)
+3 ;set flag to collect workload
IF $PIECE($GET(TIUDPRM(0)),U,16)
IF '$PIECE($GET(^TIU(8925,+DA,0)),U,11)
IF $$WORKOK^TIUPXAP1(+DA)
SET DR=DR_";.11////1"
+4 DO ^DIE
+5 QUIT
COPY12(DA,TIUD0,TIUD12,TIU) ; Copy 12-node
+1 NEW DR,DIE
SET DIE=8925
+2 SET DR="1201////"_$$NOW^TIULC_";1202////"_+$G(DUZ)_";1203////"_$PIECE(TIUD12,U,3)_";1204////"_$GET(DUZ)_";1205////"_$PIECE($GET(TIU("LOC")),U)
+3 SET DR=DR_";1206////"_$PIECE(TIUD12,U,6)_";1207////"_$PIECE(TIUD12,U,7)_";1209////"_$PIECE(TIUD12,U,9)
+4 IF +$$REQCOSIG^TIULP(+TIUD0,DA,+$GET(DUZ))
SET DR=DR_";1208////"_$PIECE(TIUD12,U,8)
+5 SET DR=DR_";1210////"_$PIECE(TIUD12,U,10)_";1211////"_+$GET(TIU("VLOC"))_";1212////"_$PIECE($GET(TIU("INST")),U)
+6 DO ^DIE
+7 QUIT
COPY13(DA,TIUD13,TIU) ; Copy 13-node
+1 NEW DR,DIE
SET DIE=8925
+2 SET DR="1301////"_$$NOW^TIULC_";1302////"_$G(DUZ)_";1303////O;1307////"_$PIECE(TIUD13,U,7)
+3 DO ^DIE
+4 QUIT
COPY14(DA,TIUD14,TIU) ; Copy 14-node
+1 NEW DR,DIE
SET DIE=8925
+2 SET DR="1401////"_$PIECE($GET(TIU("AD#")),U)_";1402////"_$PIECE($GET(TIU("TS")),U)_";1403////"_$PIECE(TIUD14,U,3)_";1404////"_$PIECE(TIUD14,U,4)
+3 DO ^DIE
+4 QUIT
COPY17(DA,TIUD17) ; Copy Subject
+1 NEW DR,DIE
SET DIE=8925
+2 IF $GET(TIUD17)']""
QUIT
+3 SET DR="1701////^S X=$G(TIUD17)"
DO ^DIE
+4 QUIT
COPYTEXT(TIUDA,DA) ; Copy text
+1 NEW TIUC,TIUI,TIUJ,TIULINE
+2 IF +$ORDER(^TIU(8925,+TIUDA,"TEXT",0))
MERGE ^TIU(8925,+DA,"TEMP")=^TIU(8925,+TIUDA,"TEXT")
+3 SET (TIUC,TIULINE)=0
SET TIUJ=+$PIECE($GET(^TIU(8925,+DA,"TEMP",0)),U,3)
+4 FOR
SET TIUC=$ORDER(^TIU(8925,"DAD",TIUDA,TIUC))
if +TIUC'>0
QUIT
Begin DoDot:1
+5 IF +$$ISADDNDM^TIULC1(TIUC)
QUIT
+6 SET TIUI=0
FOR
SET TIUI=$ORDER(^TIU(8925,+TIUC,"TEXT",TIUI))
if +TIUI'>0
QUIT
Begin DoDot:2
+7 SET TIUJ=+$GET(TIUJ)+1
+8 SET ^TIU(8925,+DA,"TEMP",TIUJ,0)=$GET(^TIU(8925,+TIUC,"TEXT",TIUI,0))
+9 SET ^TIU(8925,+DA,"TEMP",0)="^^"_TIUJ_"^"_TIUJ_"^"_DT_"^^"
End DoDot:2
End DoDot:1
+10 QUIT
