TIUT ; SLC/JER - Release from or Send back to transcription ;03/04/10 09:29
;;1.0;TEXT INTEGRATION UTILITIES;**3,4,32,100,250**;Jun 20, 1997;Build 14
;
; ICR #2053 - ^DIE
; #2324 - $$ISA^USRLM
; #10076 - ^XUSEC("TIU AUTOVERIFY",DUZ) Global Var
;
SENDBACK(DA) ; Send Document back to transcription
N DIE,DR,TIUTYP,TIUSBOK
I $$DADORKID^TIUGBR(DA) S TIUSBOK="0^You cannot send back interdisciplinary entries. They must be detached first."
I '$D(TIUSBOK) S TIUSBOK=$$CANDO^TIULP(DA,"SEND BACK")
I +TIUSBOK'>0 D Q
. W !,$C(7),$P(TIUSBOK,U,2) ; Echo denial message
. I $$READ^TIUU("EA","Press RETURN to continue...") W "" ; pause
L +^TIU(8925,+DA):1
E W !?5,$C(7),"Another user is editing this entry." H 3 Q
S TIUTYP=$P($P(^TIU(8925.1,+^TIU(8925,+DA,0),0),U),U)
I +$$CANSEND^TIULP1(DA) D
. S DR=".05///UNRELEASED;1501///@;1306///@;1305///@;1304///@",DIE=8925 D ^DIE
. W !,TIUTYP," Sent Back." H 2
. D SENDTRAN^TIUALRT(DA) S TIUCHNG=1
. ; D UPDTIRT^TIUIRT(.TIU,+DA)
E D
. W !,$C(7),$C(7),$C(7),TIUTYP," Not Sent Back." H 2
L -^TIU(8925,+DA)
Q
RELEASE(DA,TIUREL) ; Release Document from transcription
; TIUREL=1 ==> Document released
N DADTYP,DIE,DR,TIUD0,TIUTYP,TIUTNM,TIULINE,TIUDPRM
S TIUD0=$G(^TIU(8925,+DA,0)),TIUTYP=+TIUD0,TIUTNM=$$PNAME^TIULC1(TIUTYP)
; If status is beyond unsigned quit
I +$P(TIUD0,U,5)>5 Q
; If a document is already released quit
I +$P($G(^TIU(8925,DA,13)),U,4) Q
;S TIUREL=$S($G(TIUREL)]"":+$G(TIUREL),+$P($G(^TIU(8925,DA,13)),U,4):1,1:0)
D DOCPRM^TIULC1(TIUTYP,.TIUDPRM,DA)
; If Release is required, and not automatic, prompt user to determine
; whether document is ready...
I '+$G(TIUREL),+$P($G(TIUDPRM(0)),U,2) D Q:'+TIUREL
. S TIUREL=$$READ^TIUU("YO","Is this "_TIUTNM_" ready to release from DRAFT","YES","^D REL^TIUDIRH")
. I '+TIUREL W !," NOT RELEASED." H 2
; If release is not required, release automatically this assures alerts
; printing, etc. happen appropriately, even for documents where release
; from draft is not a "normal" processing step
I '+$G(TIUREL),'+$P($G(TIUDPRM(0)),U,2) S TIUREL=1
I +$G(TIUREL) D
. N TIUVBC,TIUAU,TIUEBY,TIUEC,TIUD12,TIUD13
. L +^TIU(8925,+DA):1
. E W:'$D(ZTQUEUED) !?5,$C(7),"Another user is editing this entry." H 3 Q
. S TIUD12=$G(^TIU(8925,DA,12)),TIUD13=$G(^(13))
. S TIUAU=$P(TIUD12,U,2),TIUEC=$P(TIUD12,U,8),TIUEBY=$P(TIUD13,U,2)
. S TIULINE=$$LINECNT^TIULC(DA),TIUVBC=$$VBCLINES^TIULC(+DA)
. S DR=".05///"_$S(+$$REQVER^TIULC(+DA,+$P($G(TIUDPRM(0)),U,3)):"UNVERIFIED",1:"UNSIGNED")
. S DR=DR_";.1////"_TIULINE
. ; If entered by someone other than the author or expected cosigner, store VBC Line Count
. I (TIUEBY]""),(TIUAU]""),(TIUEBY'=TIUAU) D
. . I (TIUEC]""),(TIUEBY=TIUEC) Q
. . S DR=DR_";1801////"_TIUVBC
. ; If verification is required and user holds autoverify key, stuff
. ; verifying clerk and verification date
. I +$$REQVER^TIULC(+DA,+$P($G(TIUDPRM(0)),U,3)),+$D(^XUSEC("TIU AUTOVERIFY",DUZ)) S DR=DR_";1306////"_DUZ_";1305////"_$$NOW^TIULC
. S DR=DR_";1304////"_$$NOW^TIULC,DIE=8925 D ^DIE
. L -^TIU(8925,+DA)
. I '$D(ZTQUEUED),+$$ISA^USRLM(DUZ,"TRANSCRIPTIONIST") W !,"LINES TYPED: ",TIULINE W:DR[";1801////" !?2,"VBC LINES: ",TIUVBC
I '$D(ZTQUEUED),(+$P($G(TIUDPRM(0)),U,2)=1) W !,$$PNAME^TIULC1(TIUTYP),$S(+$G(TIUREL):" Released.",1:" Unreleased.") H 2
I +$G(TIUREL) D
. N TIURELX
. S TIURELX=$$RELEASE^TIULC1(+TIUD0)
. I TIURELX]"" X TIURELX
. I +$P($G(TIUDPRM(0)),U,8)'>0 D MAIN^TIUPD(+DA,"R")
. D ALERTDEL^TIUALRT(DA)
. ;If the document does not require verification, or if the document
. ;does require verification, but the user holds the AUTOVERIFY key,
. ;send alerts
. 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)
Q
VERIFY(DA) ; Evaluate requirements for verification, prompt as appropriate
N DADTYP,TIUTYP,TIUDPRM,TIUTNM,TIUD13,TIUY
S TIUD13=$G(^TIU(8925,+DA,13))
S TIUTYP=+$G(^TIU(8925,+DA,0))
; I +$$ISADDNDM^TIULC1(DA) D I 1
; . S DADTYP=+$G(^TIU(8925,+$P(^TIU(8925,+DA,0),U,6),0))
; . D DOCPRM^TIULC1(DADTYP,.TIUDPRM)
D DOCPRM^TIULC1(TIUTYP,.TIUDPRM,+DA)
; If verification isn't required, or if the user is not authorized to
; verify the document, then quit
I '$D(TIUDPRM(0)) Q
I '+$$REQVER^TIULC(+DA,+$P(TIUDPRM(0),U,3)) Q
I '+$$CANDO^TIULP(+DA,"VERIFICATION") Q
S TIUTNM=$$PNAME^TIULC1(TIUTYP)
I +$P(TIUD13,U,5) D I 1
. W !!,"This "_TIUTNM_" is already verified."
. S TIUY=$$READ^TIUU("YO","Do you want to UNVERIFY this "_TIUTNM,"NO","^D UNVER^TIUDIRH")
. I +TIUY W !," UNVERIFIED." D
. . N DIE,DR
. . S DIE=8925,DR="1305///@;1306///@" D ^DIE W "."
. . D ALERTDEL^TIUALRT(DA)
E D
. N DIE,DR,TIUVERX
. S TIUY=$$READ^TIUU("YO","VERIFY this "_TIUTNM,"NO","^D VER^TIUDIRH")
. I '+TIUY W !," NOT VERIFIED." Q
. S DIE=8925,DR=".05///UNSIGNED;1305////"_+$G(DT)_";1306////"_DUZ D ^DIE
. I +DA W !," VERIFIED." D MAIN^TIUPD(+DA,"V"),SEND^TIUALRT(DA)
. S TIUVERX=$$VERIFY^TIULC1(+TIUTYP) I TIUVERX]"" X TIUVERX
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIUT 5151 printed Dec 13, 2024@02:46:17 Page 2
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
+2 ;
+3 ; ICR #2053 - ^DIE
+4 ; #2324 - $$ISA^USRLM
+5 ; #10076 - ^XUSEC("TIU AUTOVERIFY",DUZ) Global Var
+6 ;
SENDBACK(DA) ; Send Document back to transcription
+1 NEW DIE,DR,TIUTYP,TIUSBOK
+2 IF $$DADORKID^TIUGBR(DA)
SET TIUSBOK="0^You cannot send back interdisciplinary entries. They must be detached first."
+3 IF '$DATA(TIUSBOK)
SET TIUSBOK=$$CANDO^TIULP(DA,"SEND BACK")
+4 IF +TIUSBOK'>0
Begin DoDot:1
+5 ; Echo denial message
WRITE !,$CHAR(7),$PIECE(TIUSBOK,U,2)
+6 ; pause
IF $$READ^TIUU("EA","Press RETURN to continue...")
WRITE ""
End DoDot:1
QUIT
+7 LOCK +^TIU(8925,+DA):1
+8 IF '$TEST
WRITE !?5,$CHAR(7),"Another user is editing this entry."
HANG 3
QUIT
+9 SET TIUTYP=$PIECE($PIECE(^TIU(8925.1,+^TIU(8925,+DA,0),0),U),U)
+10 IF +$$CANSEND^TIULP1(DA)
Begin DoDot:1
+11 SET DR=".05///UNRELEASED;1501///@;1306///@;1305///@;1304///@"
SET DIE=8925
DO ^DIE
+12 WRITE !,TIUTYP," Sent Back."
HANG 2
+13 DO SENDTRAN^TIUALRT(DA)
SET TIUCHNG=1
+14 ; D UPDTIRT^TIUIRT(.TIU,+DA)
End DoDot:1
+15 IF '$TEST
Begin DoDot:1
+16 WRITE !,$CHAR(7),$CHAR(7),$CHAR(7),TIUTYP," Not Sent Back."
HANG 2
End DoDot:1
+17 LOCK -^TIU(8925,+DA)
+18 QUIT
RELEASE(DA,TIUREL) ; Release Document from transcription
+1 ; TIUREL=1 ==> Document released
+2 NEW DADTYP,DIE,DR,TIUD0,TIUTYP,TIUTNM,TIULINE,TIUDPRM
+3 SET TIUD0=$GET(^TIU(8925,+DA,0))
SET TIUTYP=+TIUD0
SET TIUTNM=$$PNAME^TIULC1(TIUTYP)
+4 ; If status is beyond unsigned quit
+5 IF +$PIECE(TIUD0,U,5)>5
QUIT
+6 ; If a document is already released quit
+7 IF +$PIECE($GET(^TIU(8925,DA,13)),U,4)
QUIT
+8 ;S TIUREL=$S($G(TIUREL)]"":+$G(TIUREL),+$P($G(^TIU(8925,DA,13)),U,4):1,1:0)
+9 DO DOCPRM^TIULC1(TIUTYP,.TIUDPRM,DA)
+10 ; If Release is required, and not automatic, prompt user to determine
+11 ; whether document is ready...
+12 IF '+$GET(TIUREL)
IF +$PIECE($GET(TIUDPRM(0)),U,2)
Begin DoDot:1
+13 SET TIUREL=$$READ^TIUU("YO","Is this "_TIUTNM_" ready to release from DRAFT","YES","^D REL^TIUDIRH")
+14 IF '+TIUREL
WRITE !," NOT RELEASED."
HANG 2
End DoDot:1
if '+TIUREL
QUIT
+15 ; If release is not required, release automatically this assures alerts
+16 ; printing, etc. happen appropriately, even for documents where release
+17 ; from draft is not a "normal" processing step
+18 IF '+$GET(TIUREL)
IF '+$PIECE($GET(TIUDPRM(0)),U,2)
SET TIUREL=1
+19 IF +$GET(TIUREL)
Begin DoDot:1
+20 NEW TIUVBC,TIUAU,TIUEBY,TIUEC,TIUD12,TIUD13
+21 LOCK +^TIU(8925,+DA):1
+22 IF '$TEST
if '$DATA(ZTQUEUED)
WRITE !?5,$CHAR(7),"Another user is editing this entry."
HANG 3
QUIT
+23 SET TIUD12=$GET(^TIU(8925,DA,12))
SET TIUD13=$GET(^(13))
+24 SET TIUAU=$PIECE(TIUD12,U,2)
SET TIUEC=$PIECE(TIUD12,U,8)
SET TIUEBY=$PIECE(TIUD13,U,2)
+25 SET TIULINE=$$LINECNT^TIULC(DA)
SET TIUVBC=$$VBCLINES^TIULC(+DA)
+26 SET DR=".05///"_$SELECT(+$$REQVER^TIULC(+DA,+$PIECE($GET(TIUDPRM(0)),U,3)):"UNVERIFIED",1:"UNSIGNED")
+27 SET DR=DR_";.1////"_TIULINE
+28 ; If entered by someone other than the author or expected cosigner, store VBC Line Count
+29 IF (TIUEBY]"")
IF (TIUAU]"")
IF (TIUEBY'=TIUAU)
Begin DoDot:2
+30 IF (TIUEC]"")
IF (TIUEBY=TIUEC)
QUIT
+31 SET DR=DR_";1801////"_TIUVBC
End DoDot:2
+32 ; If verification is required and user holds autoverify key, stuff
+33 ; verifying clerk and verification date
+34 IF +$$REQVER^TIULC(+DA,+$PIECE($GET(TIUDPRM(0)),U,3))
IF +$DATA(^XUSEC("TIU AUTOVERIFY",DUZ))
SET DR=DR_";1306////"_DUZ_";1305////"_$$NOW^TIULC
+35 SET DR=DR_";1304////"_$$NOW^TIULC
SET DIE=8925
DO ^DIE
+36 LOCK -^TIU(8925,+DA)
+37 IF '$DATA(ZTQUEUED)
IF +$$ISA^USRLM(DUZ,"TRANSCRIPTIONIST")
WRITE !,"LINES TYPED: ",TIULINE
if DR[";1801////"
WRITE !?2,"VBC LINES: ",TIUVBC
End DoDot:1
+38 IF '$DATA(ZTQUEUED)
IF (+$PIECE($GET(TIUDPRM(0)),U,2)=1)
WRITE !,$$PNAME^TIULC1(TIUTYP),$SELECT(+$GET(TIUREL):" Released.",1:" Unreleased.")
HANG 2
+39 IF +$GET(TIUREL)
Begin DoDot:1
+40 NEW TIURELX
+41 SET TIURELX=$$RELEASE^TIULC1(+TIUD0)
+42 IF TIURELX]""
XECUTE TIURELX
+43 IF +$PIECE($GET(TIUDPRM(0)),U,8)'>0
DO MAIN^TIUPD(+DA,"R")
+44 DO ALERTDEL^TIUALRT(DA)
+45 ;If the document does not require verification, or if the document
+46 ;does require verification, but the user holds the AUTOVERIFY key,
+47 ;send alerts
+48 IF $SELECT('+$$REQVER^TIULC(+DA,+$PIECE($GET(TIUDPRM(0)),U,3)):1,(+$$REQVER^TIULC(+DA,+$PIECE($GET(TIUDPRM(0)),U,3))&$DATA(^XUSEC("TIU AUTOVERIFY",+DUZ))):1,1:0)
DO SEND^TIUALRT(DA)
End DoDot:1
+49 QUIT
VERIFY(DA) ; Evaluate requirements for verification, prompt as appropriate
+1 NEW DADTYP,TIUTYP,TIUDPRM,TIUTNM,TIUD13,TIUY
+2 SET TIUD13=$GET(^TIU(8925,+DA,13))
+3 SET TIUTYP=+$GET(^TIU(8925,+DA,0))
+4 ; I +$$ISADDNDM^TIULC1(DA) D I 1
+5 ; . S DADTYP=+$G(^TIU(8925,+$P(^TIU(8925,+DA,0),U,6),0))
+6 ; . D DOCPRM^TIULC1(DADTYP,.TIUDPRM)
+7 DO DOCPRM^TIULC1(TIUTYP,.TIUDPRM,+DA)
+8 ; If verification isn't required, or if the user is not authorized to
+9 ; verify the document, then quit
+10 IF '$DATA(TIUDPRM(0))
QUIT
+11 IF '+$$REQVER^TIULC(+DA,+$PIECE(TIUDPRM(0),U,3))
QUIT
+12 IF '+$$CANDO^TIULP(+DA,"VERIFICATION")
QUIT
+13 SET TIUTNM=$$PNAME^TIULC1(TIUTYP)
+14 IF +$PIECE(TIUD13,U,5)
Begin DoDot:1
+15 WRITE !!,"This "_TIUTNM_" is already verified."
+16 SET TIUY=$$READ^TIUU("YO","Do you want to UNVERIFY this "_TIUTNM,"NO","^D UNVER^TIUDIRH")
+17 IF +TIUY
WRITE !," UNVERIFIED."
Begin DoDot:2
+18 NEW DIE,DR
+19 SET DIE=8925
SET DR="1305///@;1306///@"
DO ^DIE
WRITE "."
+20 DO ALERTDEL^TIUALRT(DA)
End DoDot:2
End DoDot:1
IF 1
+21 IF '$TEST
Begin DoDot:1
+22 NEW DIE,DR,TIUVERX
+23 SET TIUY=$$READ^TIUU("YO","VERIFY this "_TIUTNM,"NO","^D VER^TIUDIRH")
+24 IF '+TIUY
WRITE !," NOT VERIFIED."
QUIT
+25 SET DIE=8925
SET DR=".05///UNSIGNED;1305////"_+$GET(DT)_";1306////"_DUZ
DO ^DIE
+26 IF +DA
WRITE !," VERIFIED."
DO MAIN^TIUPD(+DA,"V")
DO SEND^TIUALRT(DA)
+27 SET TIUVERX=$$VERIFY^TIULC1(+TIUTYP)
IF TIUVERX]""
XECUTE TIUVERX
End DoDot:1
+28 QUIT
