TIULP1 ; SLC/JER - More functions determining privilege ;1/19/95 17:49
;;1.0;TEXT INTEGRATION UTILITIES;;Jun 20, 1997
CANADDA(DA) ;Checks if an Addendum can be added
N TIUY,TIU0,TIU13,TIU15
I 'DA S TIUY="^There is no original report." G ADDAX
S TIU0=$G(^TIU(8925,+DA,0)),TIU13=$G(^(13)),TIU15=$G(^(15))
I +$P(TIU0,U,6) S TIUY="^This is an addendum." G ADDAX
; If release is required, and document isn't released
; I ------ S TIUY="^Document isn't released from transcription.") G ADDAX
; I ------ S TIUY="^Original Discharge Summary isn't verified." G ADDAX
I +$G(DUZ)=$P(ACT,U,9) D G:$D(TIUX) ADDAX
. I '$P(ACT,U,11) S TIUX="^Discharge Summary isn't cosigned."
I +$G(DUZ)=$P(ACT,U) D G:$D(TIUX) ADDAX
. I '$P(ACT,U,4) S TIUX="^Discharge Summary isn't signed nor cosigned."
S TIUX=1
ADDAX ;Exit for CANADDA
I $P($G(TIUX),U,2)]"" S TIUX=TIUX_" Can't enter Addendum."
Q TIUX
CANEDITA(TIUDA,TIUY) ;Checks if an Addendum can be edited
N ACT,TIUX,DA,TIUCNT,SIGN,COSIGN,TIUCHIEF
S TIUCNT=0
I '$D(^TIU(8925,"DAD",+TIUDA))!(+$P($G(^TIU(8925,+TIUDA,0)),U,6)) G EDITAX
S DA=0 F S DA=$O(^TIU(8925,"DAD",+TIUDA,DA)) Q:+DA'>0 D
. S ACT=$G(^TIU(8925,+DA,"ACT")),SIGN=$P(ACT,U,4),COSIGN=$P(ACT,U,11)
. S TIUCHIEF=+$D(^XUSEC("TIU SERVICE CHIEF",+$G(DUZ)))
. I ACT']"" Q
. I $D(TIUXCRP) D Q
. . ;Transcriptionist and requires release
. . I $P($G(TIUPRM1),U,3),'$P(ACT,U,19) S TIUCNT=TIUCNT+1,TIUY(TIUCNT)=DA
. . ;Transcriptionist, doesn't require release, requires verification
. . I '$P($G(TIUPRM1),U,3),$P($G(TIUPRM1),U,2),'$P(ACT,U,8) S TIUCNT=TIUCNT+1,TIUY(TIUCNT)=DA
. ;MRT or MIS Manager and requires MAS verification
. I $P(TIUPRM1,U,2),$D(TIUMRT)!($D(^XUSEC("TIU MANAGER",+$G(DUZ)))) D Q
. . I $P(ACT,U,19),'SIGN,'COSIGN S TIUCNT=TIUCNT+1,TIUY(TIUCNT)=DA
. . I '$P(ACT,U,19),$P(ACT,U,5)=+$G(DUZ) S TIUCNT=TIUCNT+1,TIUY(TIUCNT)=DA
. ;If not transcriptionist nor MIS, transcriber can see it till signed
. I '$D(TIUXCRP),'$D(TIUMRT),'$D(^XUSEC("TIU MANAGER",+$G(DUZ))),$P(ACT,U,5)=+$G(DUZ) D Q
. . I 'SIGN,'COSIGN S TIUCNT=TIUCNT+1,TIUY(TIUCNT)=DA Q
. ;Check if author or cosigner and unreleased or unverified or signed
. I $P(ACT,U)=+$G(DUZ)!($P(ACT,U,9)=+$G(DUZ))!(TIUCHIEF)!($D(^XUSEC("TIU SURROGATE",+$G(DUZ)))) D Q
. . I +$P(TIUPRM1,U,3),'+$P(ACT,U,19) S TIUCNT=TIUCNT+1,TIUY(TIUCNT)="^ exists but is not yet released from transcription." Q
. . I +$P(TIUPRM1,U,2),'+$P(ACT,U,8) S TIUCNT=TIUCNT+1,TIUY(TIUCNT)="^ exists but is not yet verified." Q
. . I COSIGN S TIUCNT=TIUCNT+1,TIUY(TIUCNT)="^ exists but has been cosigned" Q
. . I 'SIGN,'COSIGN S TIUCNT=TIUCNT+1,TIUY(TIUCNT)=DA Q
. . I SIGN,'COSIGN,$P(ACT,U,9)=+$G(DUZ)!(TIUCHIEF) S TIUCNT=TIUCNT+1,TIUY(TIUCNT)=DA Q
EDITAX ;Exit for CANEDITA
S TIUX=$S($D(TIUY(TIUCNT)):1,1:0)
Q TIUX
READYSIG(DA) ;Check if user is provider & rec is ready for signature
N ACT,TIUY
S TIUY=0,ACT=$G(^TIU(8925,+DA,"ACT"))
I $D(^XUSEC("PROVIDER",+$G(DUZ)))!($D(^XUSEC("TIU AUTHOR",+$G(DUZ))))!($D(^XUSEC("TIU SURROGATE",+$G(DUZ)))) D
. I $P(TIUPRM1,U,2) D Q ;Verification required and completed
. . I +$P(ACT,U,8) S TIUY=1
. I $P(TIUPRM1,U,3) D Q ;Verification not required,
. . ;transcription release required and released
. . I +$P(ACT,U,19) S TIUY=1
. ; Verification and transcription release not required
. S TIUY=1
READYX ;Exit for READYSIG
Q TIUY
CANDEL(DA) ; Check whether user has authority to delete record
N Y
I $D(^XUSEC("TIU MANAGER",DUZ)) S Y=1 G CANDELX
S Y="0^You are not authorized to DELETE Discharge Summaries."
CANDELX Q Y
CANSEND(TIUDA) ; Checks of user can send DCS back to transcription
N ACT,TIUY
S ACT=$G(^TIU(8925,+TIUDA,"ACT")) D
. I +$P(ACT,U,16) S TIUY="^ Has been purged." Q
. I +$P(TIUPRM1,U,3),'+$P(ACT,U,19) S TIUY="0^ Is already available to transcription." Q
. I +$P($G(^TIU(8925,+DA,"ACT")),U,11) S TIUY="0^ Attending Physician has signed." Q
. S TIUY=+$$READ^TIUU("YO","Are you sure you want to send report back to "_$S($P(ACT,U)=$P(ACT,U,5):"author",1:"transcription"),"NO","^D SBACK^TIUDIRH")
Q TIUY
CANAMND(TIUDA) ; Checks whether user can amend a discharge summary
N ACT,TIUY
S ACT=$G(^TIU(8925,+TIUDA,"ACT"))
I +$P(ACT,U,4)'>0 S TIUY="0^ Not yet signed"
I +$P(ACT,U,11)'>0 S TIUY="0^ Not yet cosigned" G CANAMNX
S TIUY=1
CANAMNX Q TIUY
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIULP1 4364 printed Nov 22, 2024@17:52:20 Page 2
TIULP1 ; SLC/JER - More functions determining privilege ;1/19/95 17:49
+1 ;;1.0;TEXT INTEGRATION UTILITIES;;Jun 20, 1997
CANADDA(DA) ;Checks if an Addendum can be added
+1 NEW TIUY,TIU0,TIU13,TIU15
+2 IF 'DA
SET TIUY="^There is no original report."
GOTO ADDAX
+3 SET TIU0=$GET(^TIU(8925,+DA,0))
SET TIU13=$GET(^(13))
SET TIU15=$GET(^(15))
+4 IF +$PIECE(TIU0,U,6)
SET TIUY="^This is an addendum."
GOTO ADDAX
+5 ; If release is required, and document isn't released
+6 ; I ------ S TIUY="^Document isn't released from transcription.") G ADDAX
+7 ; I ------ S TIUY="^Original Discharge Summary isn't verified." G ADDAX
+8 IF +$GET(DUZ)=$PIECE(ACT,U,9)
Begin DoDot:1
+9 IF '$PIECE(ACT,U,11)
SET TIUX="^Discharge Summary isn't cosigned."
End DoDot:1
if $DATA(TIUX)
GOTO ADDAX
+10 IF +$GET(DUZ)=$PIECE(ACT,U)
Begin DoDot:1
+11 IF '$PIECE(ACT,U,4)
SET TIUX="^Discharge Summary isn't signed nor cosigned."
End DoDot:1
if $DATA(TIUX)
GOTO ADDAX
+12 SET TIUX=1
ADDAX ;Exit for CANADDA
+1 IF $PIECE($GET(TIUX),U,2)]""
SET TIUX=TIUX_" Can't enter Addendum."
+2 QUIT TIUX
CANEDITA(TIUDA,TIUY) ;Checks if an Addendum can be edited
+1 NEW ACT,TIUX,DA,TIUCNT,SIGN,COSIGN,TIUCHIEF
+2 SET TIUCNT=0
+3 IF '$DATA(^TIU(8925,"DAD",+TIUDA))!(+$PIECE($GET(^TIU(8925,+TIUDA,0)),U,6))
GOTO EDITAX
+4 SET DA=0
FOR
SET DA=$ORDER(^TIU(8925,"DAD",+TIUDA,DA))
if +DA'>0
QUIT
Begin DoDot:1
+5 SET ACT=$GET(^TIU(8925,+DA,"ACT"))
SET SIGN=$PIECE(ACT,U,4)
SET COSIGN=$PIECE(ACT,U,11)
+6 SET TIUCHIEF=+$DATA(^XUSEC("TIU SERVICE CHIEF",+$GET(DUZ)))
+7 IF ACT']""
QUIT
+8 IF $DATA(TIUXCRP)
Begin DoDot:2
+9 ;Transcriptionist and requires release
+10 IF $PIECE($GET(TIUPRM1),U,3)
IF '$PIECE(ACT,U,19)
SET TIUCNT=TIUCNT+1
SET TIUY(TIUCNT)=DA
+11 ;Transcriptionist, doesn't require release, requires verification
+12 IF '$PIECE($GET(TIUPRM1),U,3)
IF $PIECE($GET(TIUPRM1),U,2)
IF '$PIECE(ACT,U,8)
SET TIUCNT=TIUCNT+1
SET TIUY(TIUCNT)=DA
End DoDot:2
QUIT
+13 ;MRT or MIS Manager and requires MAS verification
+14 IF $PIECE(TIUPRM1,U,2)
IF $DATA(TIUMRT)!($DATA(^XUSEC("TIU MANAGER",+$GET(DUZ))))
Begin DoDot:2
+15 IF $PIECE(ACT,U,19)
IF 'SIGN
IF 'COSIGN
SET TIUCNT=TIUCNT+1
SET TIUY(TIUCNT)=DA
+16 IF '$PIECE(ACT,U,19)
IF $PIECE(ACT,U,5)=+$GET(DUZ)
SET TIUCNT=TIUCNT+1
SET TIUY(TIUCNT)=DA
End DoDot:2
QUIT
+17 ;If not transcriptionist nor MIS, transcriber can see it till signed
+18 IF '$DATA(TIUXCRP)
IF '$DATA(TIUMRT)
IF '$DATA(^XUSEC("TIU MANAGER",+$GET(DUZ)))
IF $PIECE(ACT,U,5)=+$GET(DUZ)
Begin DoDot:2
+19 IF 'SIGN
IF 'COSIGN
SET TIUCNT=TIUCNT+1
SET TIUY(TIUCNT)=DA
QUIT
End DoDot:2
QUIT
+20 ;Check if author or cosigner and unreleased or unverified or signed
+21 IF $PIECE(ACT,U)=+$GET(DUZ)!($PIECE(ACT,U,9)=+$GET(DUZ))!(TIUCHIEF)!($DATA(^XUSEC("TIU SURROGATE",+$GET(DUZ))))
Begin DoDot:2
+22 IF +$PIECE(TIUPRM1,U,3)
IF '+$PIECE(ACT,U,19)
SET TIUCNT=TIUCNT+1
SET TIUY(TIUCNT)="^ exists but is not yet released from transcription."
QUIT
+23 IF +$PIECE(TIUPRM1,U,2)
IF '+$PIECE(ACT,U,8)
SET TIUCNT=TIUCNT+1
SET TIUY(TIUCNT)="^ exists but is not yet verified."
QUIT
+24 IF COSIGN
SET TIUCNT=TIUCNT+1
SET TIUY(TIUCNT)="^ exists but has been cosigned"
QUIT
+25 IF 'SIGN
IF 'COSIGN
SET TIUCNT=TIUCNT+1
SET TIUY(TIUCNT)=DA
QUIT
+26 IF SIGN
IF 'COSIGN
IF $PIECE(ACT,U,9)=+$GET(DUZ)!(TIUCHIEF)
SET TIUCNT=TIUCNT+1
SET TIUY(TIUCNT)=DA
QUIT
End DoDot:2
QUIT
End DoDot:1
EDITAX ;Exit for CANEDITA
+1 SET TIUX=$SELECT($DATA(TIUY(TIUCNT)):1,1:0)
+2 QUIT TIUX
READYSIG(DA) ;Check if user is provider & rec is ready for signature
+1 NEW ACT,TIUY
+2 SET TIUY=0
SET ACT=$GET(^TIU(8925,+DA,"ACT"))
+3 IF $DATA(^XUSEC("PROVIDER",+$GET(DUZ)))!($DATA(^XUSEC("TIU AUTHOR",+$GET(DUZ))))!($DATA(^XUSEC("TIU SURROGATE",+$GET(DUZ))))
Begin DoDot:1
+4 ;Verification required and completed
IF $PIECE(TIUPRM1,U,2)
Begin DoDot:2
+5 IF +$PIECE(ACT,U,8)
SET TIUY=1
End DoDot:2
QUIT
+6 ;Verification not required,
IF $PIECE(TIUPRM1,U,3)
Begin DoDot:2
+7 ;transcription release required and released
+8 IF +$PIECE(ACT,U,19)
SET TIUY=1
End DoDot:2
QUIT
+9 ; Verification and transcription release not required
+10 SET TIUY=1
End DoDot:1
READYX ;Exit for READYSIG
+1 QUIT TIUY
CANDEL(DA) ; Check whether user has authority to delete record
+1 NEW Y
+2 IF $DATA(^XUSEC("TIU MANAGER",DUZ))
SET Y=1
GOTO CANDELX
+3 SET Y="0^You are not authorized to DELETE Discharge Summaries."
CANDELX QUIT Y
CANSEND(TIUDA) ; Checks of user can send DCS back to transcription
+1 NEW ACT,TIUY
+2 SET ACT=$GET(^TIU(8925,+TIUDA,"ACT"))
Begin DoDot:1
+3 IF +$PIECE(ACT,U,16)
SET TIUY="^ Has been purged."
QUIT
+4 IF +$PIECE(TIUPRM1,U,3)
IF '+$PIECE(ACT,U,19)
SET TIUY="0^ Is already available to transcription."
QUIT
+5 IF +$PIECE($GET(^TIU(8925,+DA,"ACT")),U,11)
SET TIUY="0^ Attending Physician has signed."
QUIT
+6 SET TIUY=+$$READ^TIUU("YO","Are you sure you want to send report back to "_$SELECT($PIECE(ACT,U)=$PIECE(ACT,U,5):"author",1:"transcription"),"NO","^D SBACK^TIUDIRH")
End DoDot:1
+7 QUIT TIUY
CANAMND(TIUDA) ; Checks whether user can amend a discharge summary
+1 NEW ACT,TIUY
+2 SET ACT=$GET(^TIU(8925,+TIUDA,"ACT"))
+3 IF +$PIECE(ACT,U,4)'>0
SET TIUY="0^ Not yet signed"
+4 IF +$PIECE(ACT,U,11)'>0
SET TIUY="0^ Not yet cosigned"
GOTO CANAMNX
+5 SET TIUY=1
CANAMNX QUIT TIUY
