- 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 Feb 19, 2025@00:11:35 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