Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: TIURC1

TIURC1.m

Go to the documentation of this file.
  1. TIURC1 ; SLC/JER - Additional Review screen actions ;4/13/05
  1. ;;1.0;TEXT INTEGRATION UTILITIES;**100,113,184**;Jun 20, 1997
  1. COPY ; Copy
  1. N DA,DIE,DR,TIU,TIUCHNG,TIUDATA,TIUI,TIUY,Y,DIROUT
  1. N TIUVIEW,TIULST,TIUNREC,TIUDAARY,OLDNREC
  1. I '$D(VALMY) D EN^VALM2(XQORNOD(0))
  1. S TIUI=0
  1. F S TIUI=$O(VALMY(TIUI)) Q:+TIUI'>0 D Q:$D(DIROUT)
  1. . N TIU,RSTRCTD
  1. . S TIUDATA=$G(^TMP("TIURIDX",$J,TIUI))
  1. . S TIUDA=+$P(TIUDATA,U,2) S RSTRCTD=$$DOCRES^TIULRR(TIUDA)
  1. . I RSTRCTD D Q
  1. . . W !!,$C(7),"Ok, no harm done...",!
  1. . . I $$READ^TIUU("EA","RETURN to continue...") ; pause
  1. . S TIUVIEW=$$CANDO^TIULP(TIUDA,"VIEW")
  1. . I +TIUVIEW'>0 D Q
  1. . . W !!,$C(7),$P(TIUVIEW,U,2),!
  1. . . I $$READ^TIUU("EA","RETURN to continue...") ; pause
  1. . S OLDNREC=$G(TIUNREC)
  1. . ; -- Single docmt copy. Does COPY1.
  1. . ; Generates list TIUNREC of new recs for feedback
  1. . D EN^VALM("TIU COPY DOCUMENT")
  1. . K ^TMP("TIUVIEW",$J)
  1. . I $G(TIUNREC)'=OLDNREC D
  1. . . S TIUDAARY(TIUI)=TIUDA
  1. . . S TIULST=$G(TIULST)_$S($G(TIULST)]"":",",1:"")_TIUI
  1. I +$G(TIUNREC) D
  1. . N TIUI,TIUNDA,TIUITEM
  1. . F TIUI=1:1:$L($G(TIUNREC),",") D
  1. . . S TIUNDA=$P(TIUNREC,",",TIUI),TIUITEM=+$G(^TMP("TIUR",$J,0))
  1. . . D ADDELMNT^TIUR2(TIUNDA,+TIUITEM,1)
  1. S TIUCHNG("REFRESH")=1
  1. D UPRBLD^TIURL(.TIUCHNG,.VALMY) K VALMY
  1. S VALMBCK="R"
  1. D VMSG^TIURS1($G(TIULST),.TIUDAARY,"copied")
  1. Q
  1. COPY1 ; Copy a document
  1. N TIUOD0,TIUOD12,TIUD13,TIUOD14,TIUOD17,TIUI,TIUPAT,TIUTNM,TIUTYP
  1. N TIUDPRM,TIUPOP,TIUCOPY,TIUVSUPP,DUOUT,DIROUT,DTOUT,TIUASK
  1. S TIUPOP=0
  1. I +$$ISADDNDM^TIULC1(TIUDA) D Q
  1. . W !,$C(7),"ADDENDA may not be copied."
  1. . I $$READ^TIUU("EA","Press RETURN to continue...") W ""
  1. S TIUCOPY=$$CANDO^TIULP(TIUDA,"COPY RECORD")
  1. I +TIUCOPY'>0 D Q
  1. . W !!,$C(7),$P(TIUCOPY,U,2),!
  1. . I $$READ^TIUU("EA","RETURN to continue...") ; pause
  1. S TIUOD0=$G(^TIU(8925,+TIUDA,0)),TIUOD12=$G(^(12)),TIUD13=$G(^(13))
  1. S TIUOD14=$G(^TIU(8925,+TIUDA,14)),TIUOD17=$G(^TIU(8925,+TIUDA,17))
  1. S TIUTYP=+TIUOD0
  1. D FULL^VALM1
  1. I $$CHKTITLE(+TIUTYP) D Q:$G(TIUOUT)=1
  1. . N TIUDOC0,TIUDCLS
  1. . S TIUDOC0=$G(^TIU(8925.1,TIUTYP,0))
  1. . W !
  1. . I $P(TIUDOC0,U,7)=13 D
  1. . . W !,$C(7),$P(TIUDOC0,U,3)," is an inactive title."
  1. . W !,"You must now select a new, active title BEFORE the note is copied:",!
  1. . S TIUDCLS=+$$CLINDOC^TIULC1(+TIUTYP,TIUDA),TIUTYP=0
  1. . D DOCSPICK^TIULA2(.TIUTYP,TIUDCLS,"1A","","","+$$CANPICK^TIULP(+Y),+$$CANENTR^TIULP(+Y)")
  1. . I TIUTYP'>0 S TIUOUT=1
  1. . E D
  1. . . S TIUTYP=$P($G(TIUTYP(1)),U,2)
  1. . . I $$CHKTITLE(+TIUTYP) S TIUOUT=1
  1. D DOCPRM^TIULC1(TIUTYP,.TIUDPRM,TIUDA)
  1. S TIUTNM=$$PNAME^TIULC1(+TIUTYP)
  1. S TIUTYP(1)="1^"_+TIUTYP_U_TIUTNM_U
  1. W !!,"Please Choose One or More Patients for whom the document should be copied:",!
  1. F D Q:+TIUPOP
  1. . D PATIENT^ORU1(.TIUPAT,1)
  1. . I +TIUPAT'>0 D Q
  1. . . W !,$C(7),"No patient(s) selected..."
  1. . . I $$READ^TIUU("EA","Press RETURN to continue...") W !
  1. . . S TIUCHNG=0,TIUPOP=1
  1. . S TIUI=0 F S TIUI=$O(TIUPAT(TIUI)) Q:+TIUI'>0 D
  1. . . N DA,DR,DFN,TIU,TIULMETH,TIUVMETH,TIUPATNM
  1. . . S DFN=+TIUPAT(TIUI),TIUPATNM=$P(TIUPAT(TIUI),U,2)
  1. . . S TIUVSUPP=+$$SUPPVSIT^TIULC1(TIUTYP)
  1. . . I TIUVSUPP'>0 D I 1
  1. . . . S TIULMETH=$$GETLMETH^TIUEDI1(TIUTYP)
  1. . . . I '$L(TIULMETH) D S TIUOUT=1 Q
  1. . . . . W !,$C(7),"No Visit Linkage Method defined for "
  1. . . . . W $$PNAME^TIULC1(TIUTYP),".",!,"Please contact IRM..."
  1. . . . . I $$READ^TIUU("EA","Press RETURN to continue...") W ""
  1. . . . W !!,"For Patient ",TIUPATNM
  1. . . . X TIULMETH
  1. . . E D EVENT^TIUSRVP1(.TIU,DFN)
  1. . . I '$D(TIU("VSTR")) W !,$C(7),"Patient & Visit required." H 2 Q
  1. . . S TIUVMETH=$$GETVMETH^TIUEDI1(TIUTYP)
  1. . . I '$L(TIUVMETH) D S TIUOUT=1 Q
  1. . . . W !,$C(7),"No Validation Method defined for "
  1. . . . W $$PNAME^TIULC1(TIUTYP),".",!,"Please contact IRM..."
  1. . . X TIUVMETH
  1. . . I $D(TIU),+$G(TIUASK) D
  1. . . . N TIUNEW,TIUITEM,DA,DR,DIE
  1. . . . S DA=$$GETRECNW^TIUEDI3(DFN,.TIU,TIUTYP(1),.TIUNEW,.TIUDPRM) Q:+DA'>0
  1. . . . I '+$G(TIUNEW) D Q
  1. . . . . W !!,$C(7),"A ",$P(TIUTYP(1),U,3)," already exists for this visit."
  1. . . . . W !,"You may not use the copy function to overwrite an existing ",!,$$UPPER^TIULS($$STATUS^TIULC(DA))," ",$P(TIUTYP(1),U,3),".",!
  1. . . . . I $$READ^TIUU("EA","Press RETURN to continue...") W ""
  1. . . . D COPY0(DA,TIUOD0,.TIU),COPY12(DA,TIUOD0,TIUOD12,.TIU),COPY13(DA,TIUD13)
  1. . . . D COPY14(DA,TIUOD14,.TIU),COPY17(DA,TIUOD17),COPYTEXT(TIUDA,DA)
  1. . . . I $D(^TIU(8925,DA,"TEMP")) D MERGTEXT^TIUEDI1(DA,.TIU) K ^TIU(8925,+DA,"TEMP")
  1. . . . S DR=".05///"_$$UPPER^TIULS($$STATUS^TIULC(DA)),DIE=8925 D ^DIE
  1. . . . I +$D(^TIU(8925,+DA,"TEXT"))>9!(+$O(^TIU(8925,"DAD",+DA,0))>0) D
  1. . . . . N TIUDA,TIUCPYNG S TIUDA=+DA,TIUCPYNG=1 D EDIT1^TIURA
  1. . . . I '$G(DA) Q ;Docmt deleted in TIURA
  1. . . . S TIUCHNG=1,TIUNREC=$G(TIUNREC)_$S(+$G(TIUNREC):",",1:"")_DA
  1. . S TIUPOP='+$$AGAIN
  1. Q
  1. CHKTITLE(TIUTYP) ; Title Status
  1. N TIUBAD S TIUBAD=0
  1. I +$$CANPICK^TIULP(+TIUTYP)'>0 S TIUBAD=1 I 1
  1. E I +$$CANENTR^TIULP(+TIUTYP)'>0 S TIUBAD=1
  1. Q TIUBAD
  1. AGAIN() ; Ask again?
  1. N TIUY W !
  1. S TIUY=$$READ^TIUU("Y","Copy this note again","No")
  1. Q TIUY
  1. COPY0(DA,TIUD0,TIU) ; Copy 0-node
  1. N DR,DIE S DIE=8925
  1. 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)
  1. 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
  1. D ^DIE
  1. Q
  1. COPY12(DA,TIUD0,TIUD12,TIU) ; Copy 12-node
  1. N DR,DIE S DIE=8925
  1. S DR="1201////"_$$NOW^TIULC_";1202////"_+$G(DUZ)_";1203////"_$P(TIUD12,U,3)_";1204////"_$G(DUZ)_";1205////"_$P($G(TIU("LOC")),U)
  1. S DR=DR_";1206////"_$P(TIUD12,U,6)_";1207////"_$P(TIUD12,U,7)_";1209////"_$P(TIUD12,U,9)
  1. I +$$REQCOSIG^TIULP(+TIUD0,DA,+$G(DUZ)) S DR=DR_";1208////"_$P(TIUD12,U,8)
  1. S DR=DR_";1210////"_$P(TIUD12,U,10)_";1211////"_+$G(TIU("VLOC"))_";1212////"_$P($G(TIU("INST")),U)
  1. D ^DIE
  1. Q
  1. COPY13(DA,TIUD13,TIU) ; Copy 13-node
  1. N DR,DIE S DIE=8925
  1. S DR="1301////"_$$NOW^TIULC_";1302////"_$G(DUZ)_";1303////O;1307////"_$P(TIUD13,U,7)
  1. D ^DIE
  1. Q
  1. COPY14(DA,TIUD14,TIU) ; Copy 14-node
  1. N DR,DIE S DIE=8925
  1. S DR="1401////"_$P($G(TIU("AD#")),U)_";1402////"_$P($G(TIU("TS")),U)_";1403////"_$P(TIUD14,U,3)_";1404////"_$P(TIUD14,U,4)
  1. D ^DIE
  1. Q
  1. COPY17(DA,TIUD17) ; Copy Subject
  1. N DR,DIE S DIE=8925
  1. I $G(TIUD17)']"" Q
  1. S DR="1701////^S X=$G(TIUD17)" D ^DIE
  1. Q
  1. COPYTEXT(TIUDA,DA) ; Copy text
  1. N TIUC,TIUI,TIUJ,TIULINE
  1. I +$O(^TIU(8925,+TIUDA,"TEXT",0)) M ^TIU(8925,+DA,"TEMP")=^TIU(8925,+TIUDA,"TEXT")
  1. S (TIUC,TIULINE)=0,TIUJ=+$P($G(^TIU(8925,+DA,"TEMP",0)),U,3)
  1. F S TIUC=$O(^TIU(8925,"DAD",TIUDA,TIUC)) Q:+TIUC'>0 D
  1. . I +$$ISADDNDM^TIULC1(TIUC) Q
  1. . S TIUI=0 F S TIUI=$O(^TIU(8925,+TIUC,"TEXT",TIUI)) Q:+TIUI'>0 D
  1. . . S TIUJ=+$G(TIUJ)+1
  1. . . S ^TIU(8925,+DA,"TEMP",TIUJ,0)=$G(^TIU(8925,+TIUC,"TEXT",TIUI,0))
  1. . . S ^TIU(8925,+DA,"TEMP",0)="^^"_TIUJ_"^"_TIUJ_"^"_DT_"^^"
  1. Q