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

TIUT.m

Go to the documentation of this file. 
  1. TIUT ; SLC/JER - Release from or Send back to transcription ;03/04/10  09:29
  1.  ;;1.0;TEXT INTEGRATION UTILITIES;**3,4,32,100,250**;Jun 20, 1997;Build 14
  1.  ;
  1.  ; ICR #2053    - ^DIE
  1.  ;     #2324    - $$ISA^USRLM
  1.  ;     #10076   - ^XUSEC("TIU AUTOVERIFY",DUZ) Global Var
  1.  ;
  1. SENDBACK(DA) ; Send Document back to transcription
  1.  N DIE,DR,TIUTYP,TIUSBOK
  1.  I $$DADORKID^TIUGBR(DA) S TIUSBOK="0^You cannot send back interdisciplinary entries. They must be detached first."
  1.  I '$D(TIUSBOK) S TIUSBOK=$$CANDO^TIULP(DA,"SEND BACK")
  1.  I +TIUSBOK'>0 D  Q
  1.  . W !,$C(7),$P(TIUSBOK,U,2) ; Echo denial message
  1.  . I $$READ^TIUU("EA","Press RETURN to continue...") W "" ; pause
  1.  L +^TIU(8925,+DA):1
  1.  E  W !?5,$C(7),"Another user is editing this entry." H 3 Q
  1.  S TIUTYP=$P($P(^TIU(8925.1,+^TIU(8925,+DA,0),0),U),U)
  1.  I +$$CANSEND^TIULP1(DA) D
  1.  . S DR=".05///UNRELEASED;1501///@;1306///@;1305///@;1304///@",DIE=8925 D ^DIE
  1.  . W !,TIUTYP," Sent Back." H 2
  1.  . D SENDTRAN^TIUALRT(DA) S TIUCHNG=1
  1.  . ; D UPDTIRT^TIUIRT(.TIU,+DA)
  1.  E  D
  1.  . W !,$C(7),$C(7),$C(7),TIUTYP," Not Sent Back." H 2
  1.  L -^TIU(8925,+DA)
  1.  Q
  1. RELEASE(DA,TIUREL) ; Release Document from transcription
  1.  ; TIUREL=1 ==> Document released
  1.  N DADTYP,DIE,DR,TIUD0,TIUTYP,TIUTNM,TIULINE,TIUDPRM
  1.  S TIUD0=$G(^TIU(8925,+DA,0)),TIUTYP=+TIUD0,TIUTNM=$$PNAME^TIULC1(TIUTYP)
  1.  ; If status is beyond unsigned quit
  1.  I +$P(TIUD0,U,5)>5 Q
  1.  ; If a document is already released quit
  1.  I +$P($G(^TIU(8925,DA,13)),U,4) Q
  1.  ;S TIUREL=$S($G(TIUREL)]"":+$G(TIUREL),+$P($G(^TIU(8925,DA,13)),U,4):1,1:0)
  1.  D DOCPRM^TIULC1(TIUTYP,.TIUDPRM,DA)
  1.  ; If Release is required, and not automatic, prompt user to determine
  1.  ; whether document is ready...
  1.  I '+$G(TIUREL),+$P($G(TIUDPRM(0)),U,2) D  Q:'+TIUREL
  1.  . S TIUREL=$$READ^TIUU("YO","Is this "_TIUTNM_" ready to release from DRAFT","YES","^D REL^TIUDIRH")
  1.  . I '+TIUREL W !," NOT RELEASED." H 2
  1.  ; If release is not required, release automatically this assures alerts
  1.  ; printing, etc. happen appropriately, even for documents where release
  1.  ; from draft is not a "normal" processing step
  1.  I '+$G(TIUREL),'+$P($G(TIUDPRM(0)),U,2) S TIUREL=1
  1.  I +$G(TIUREL) D
  1.  . N TIUVBC,TIUAU,TIUEBY,TIUEC,TIUD12,TIUD13
  1.  . L +^TIU(8925,+DA):1
  1.  . E  W:'$D(ZTQUEUED) !?5,$C(7),"Another user is editing this entry." H 3 Q
  1.  . S TIUD12=$G(^TIU(8925,DA,12)),TIUD13=$G(^(13))
  1.  . S TIUAU=$P(TIUD12,U,2),TIUEC=$P(TIUD12,U,8),TIUEBY=$P(TIUD13,U,2)
  1.  . S TIULINE=$$LINECNT^TIULC(DA),TIUVBC=$$VBCLINES^TIULC(+DA)
  1.  . S DR=".05///"_$S(+$$REQVER^TIULC(+DA,+$P($G(TIUDPRM(0)),U,3)):"UNVERIFIED",1:"UNSIGNED")
  1.  . S DR=DR_";.1////"_TIULINE
  1.  . ; If entered by someone other than the author or expected cosigner, store VBC Line Count
  1.  . I (TIUEBY]""),(TIUAU]""),(TIUEBY'=TIUAU) D
  1.  . . I (TIUEC]""),(TIUEBY=TIUEC) Q
  1.  . . S DR=DR_";1801////"_TIUVBC
  1.  . ; If verification is required and user holds autoverify key, stuff
  1.  . ; verifying clerk and verification date
  1.  . I +$$REQVER^TIULC(+DA,+$P($G(TIUDPRM(0)),U,3)),+$D(^XUSEC("TIU AUTOVERIFY",DUZ)) S DR=DR_";1306////"_DUZ_";1305////"_$$NOW^TIULC
  1.  . S DR=DR_";1304////"_$$NOW^TIULC,DIE=8925 D ^DIE
  1.  . L -^TIU(8925,+DA)
  1.  . I '$D(ZTQUEUED),+$$ISA^USRLM(DUZ,"TRANSCRIPTIONIST") W !,"LINES TYPED: ",TIULINE W:DR[";1801////" !?2,"VBC LINES: ",TIUVBC
  1.  I '$D(ZTQUEUED),(+$P($G(TIUDPRM(0)),U,2)=1) W !,$$PNAME^TIULC1(TIUTYP),$S(+$G(TIUREL):" Released.",1:" Unreleased.") H 2
  1.  I +$G(TIUREL) D
  1.  . N TIURELX
  1.  . S TIURELX=$$RELEASE^TIULC1(+TIUD0)
  1.  . I TIURELX]"" X TIURELX
  1.  . I +$P($G(TIUDPRM(0)),U,8)'>0 D MAIN^TIUPD(+DA,"R")
  1.  . D ALERTDEL^TIUALRT(DA)
  1.  . ;If the document does not require verification, or if the document
  1.  . ;does require verification, but the user holds the AUTOVERIFY key,
  1.  . ;send alerts
  1.  . I $S('+$$REQVER^TIULC(+DA,+$P($G(TIUDPRM(0)),U,3)):1,(+$$REQVER^TIULC(+DA,+$P($G(TIUDPRM(0)),U,3))&$D(^XUSEC("TIU AUTOVERIFY",+DUZ))):1,1:0) D SEND^TIUALRT(DA)
  1.  Q
  1. VERIFY(DA) ; Evaluate requirements for verification, prompt as appropriate
  1.  N DADTYP,TIUTYP,TIUDPRM,TIUTNM,TIUD13,TIUY
  1.  S TIUD13=$G(^TIU(8925,+DA,13))
  1.  S TIUTYP=+$G(^TIU(8925,+DA,0))
  1.  ; I +$$ISADDNDM^TIULC1(DA) D  I 1
  1.  ; . S DADTYP=+$G(^TIU(8925,+$P(^TIU(8925,+DA,0),U,6),0))
  1.  ; . D DOCPRM^TIULC1(DADTYP,.TIUDPRM)
  1.  D DOCPRM^TIULC1(TIUTYP,.TIUDPRM,+DA)
  1.  ; If verification isn't required, or if the user is not authorized to
  1.  ; verify the document, then quit
  1.  I '$D(TIUDPRM(0)) Q
  1.  I '+$$REQVER^TIULC(+DA,+$P(TIUDPRM(0),U,3)) Q
  1.  I '+$$CANDO^TIULP(+DA,"VERIFICATION") Q
  1.  S TIUTNM=$$PNAME^TIULC1(TIUTYP)
  1.  I +$P(TIUD13,U,5) D  I 1
  1.  . W !!,"This "_TIUTNM_" is already verified."
  1.  . S TIUY=$$READ^TIUU("YO","Do you want to UNVERIFY this "_TIUTNM,"NO","^D UNVER^TIUDIRH")
  1.  . I +TIUY W !," UNVERIFIED." D
  1.  . . N DIE,DR
  1.  . . S DIE=8925,DR="1305///@;1306///@" D ^DIE W "."
  1.  . . D ALERTDEL^TIUALRT(DA)
  1.  E  D
  1.  . N DIE,DR,TIUVERX
  1.  . S TIUY=$$READ^TIUU("YO","VERIFY this "_TIUTNM,"NO","^D VER^TIUDIRH")
  1.  . I '+TIUY W !," NOT VERIFIED." Q
  1.  . S DIE=8925,DR=".05///UNSIGNED;1305////"_+$G(DT)_";1306////"_DUZ D ^DIE
  1.  . I +DA W !," VERIFIED." D MAIN^TIUPD(+DA,"V"),SEND^TIUALRT(DA)
  1.  . S TIUVERX=$$VERIFY^TIULC1(+TIUTYP) I TIUVERX]"" X TIUVERX
  1.  Q