- 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 Mar 13, 2025@21:47:16 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
