TIURA3 ; SLC/JER - Review screen actions ; 11/21/07
;;1.0;TEXT INTEGRATION UTILITIES;**220,234**;Jun 20, 1997;Build 6
; Call to ISA^USRLM supported by DBIA 2324
; Call to ISTERM^USRLM supported by DBIA 2712
EDITCOS ; Edit Expected Cosigner
N TIUDA,TIUDATA,TIUCHNG,TIUI,DIROUT,TIUDAARY
N TIULST,MSGVERB,TIUXNOD
S TIUXNOD=$G(XQORNOD(0))
I $P(TIUXNOD,U,3)="EC" W "Edit Cosigner",! S $P(TIUXNOD,U,4)="EC="_$P($P(TIUXNOD,U,4),"==",2)
S TIUI=0
I '$D(VALMY) D EN^VALM2(TIUXNOD)
F S TIUI=$O(VALMY(TIUI)) Q:+TIUI'>0 D Q:$D(DIROUT)
. N RSTRCTD
. S TIUDATA=$G(^TMP("TIURIDX",$J,TIUI))
. D CLEAR^VALM1 W !!,"Editing #",+TIUDATA
. S TIUDA=+$P(TIUDATA,U,2) S RSTRCTD=$$DOCRES^TIULRR(TIUDA)
. I RSTRCTD D Q
. . W !!,$C(7),"Ok, no harm done...",!
. . I $$READ^TIUU("EA","RETURN to continue...") ; pause
. S TIUDAARY(TIUI)=TIUDA
. S TIUCHNG=0
. I +$D(^TIU(8925,+TIUDA,0)) D EDITCOS1
. I +$G(TIUCHNG) D
. . S TIULST=$G(TIULST)_$S($G(TIULST)]"":",",1:"")_TIUI
; -- Update or Rebuild list, restore video: --
S TIUCHNG("UPDATE")=1
D UPRBLD^TIURL(.TIUCHNG,.VALMY) K VALMY
S VALMBCK="R"
S MSGVERB="edited"
D VMSG^TIURS1($G(TIULST),.TIUDAARY,MSGVERB)
Q
EDITCOS1 ; Edit expected cosigner/attending for single record
; Receives TIUDA
I '+$G(TIUDA) W !,"No Documents selected." H 2 Q
; Evaluate edit privilege
N NODE0,STATUS,OK2CHNG,NODE12,REQCOSIG
N ECSIGNER,ESIGNER,OKCLASS,TIUISDS,DA,DR,DIE,X
N ALTNODE0,ALTTIUDA,NESIGNR,NECSIGNR,ATTEND,NATTEND,CHKSUM,LNO,MSGNO
N CANDO,TIUISCP,TIUISCST,TIUISPN,MSG
; NECSIGNER,NATTEND etc,(N for new) means post-edit. It may not differ
;from the original. It may be null if the original was null.
S NODE0=^TIU(8925,TIUDA,0),STATUS=$P(NODE0,U,5),(OK2CHNG,OKCLASS)=1
S ALTNODE0=NODE0,ALTTIUDA=TIUDA,NODE12=$G(^TIU(8925,TIUDA,12))
I $$ISADDNDM^TIULC1(TIUDA) D
. S ALTTIUDA=$P(NODE0,U,6)
. S ALTNODE0=^TIU(8925,ALTTIUDA,0)
S TIUISDS=$$ISDS^TIULX(+ALTNODE0),TIUISPN=$$ISPN^TIULX(+ALTNODE0)
S TIUISCST=$$ISA^TIULX(+ALTNODE0,$$CLASS^TIUCNSLT())
S TIUISCP=$$ISA^TIULX(+ALTNODE0,$$CLASS^TIUCP())
I 'TIUISDS,'TIUISPN,'TIUISCST,'TIUISCP D G COS1X
. S MSG(1,1)=" This action is permitted only for Progress Notes, Discharge"
. S MSG(1,2)="Summaries, Clinical Procedures and Consults."
I STATUS>6 S MSG(2,1)=" This document has already been Completed!" G COS1X
I STATUS<5 S MSG(3,1)=" This document still needs Release or Verification!" G COS1X
; Status = 5 unsigned or 6 uncosigned:
; Try rules for EDIT COSIGNER:
S CANDO=$$CANDO^TIULP(TIUDA,"EDIT COSIGNER")
I 'CANDO S MSG(4,1)=" "_$P(CANDO,U,2) G:STATUS=6 COS1X
; If docmt is unsigned and EDIT COSIGNER rules failed,
; try EDIT RECORD rules:
I STATUS=5,'CANDO D G:'CANDO COS1X
. S CANDO=$$CANDO^TIULP(TIUDA,"EDIT RECORD")
. I CANDO K MSG(4) Q
. S MSG(5,1)=" You are not authorized to edit any aspect of this document."
; User authorized to change Expected Cosigner/attending:
S DA=TIUDA,DIE=8925
;
; **Docmt is PN, CP or Consult**
I 'TIUISDS D G COS1X
. S ESIGNER=$P(NODE12,U,4)
. S ECSIGNER=$P(NODE12,U,8)
. I ESIGNER'>0 S MSG(6,1)=" This document has no Expected Signer!" Q
. S REQCOSIG=$$REQCOSIG^TIULP(+NODE0,+TIUDA,ESIGNER)
. ;
. ; **Cosig NOT REQUIRED:**
. I 'REQCOSIG D Q
. . ; Status Uncosigned - Do not permit completion of notes:
. . I STATUS=6 D Q
. . . S MSG(7,1)=" Cosignature is not currently required. This option cannot be"
. . . S MSG(7,2)="used to change document status to COMPLETED. It looks like the author's"
. . . S MSG(7,3)="requirement has changed since this document was written."
. . . S MSG(7,4)="Please contact your CAC and/or HIMS for assistance."
. . ; Unsigned, Has no EC:
. . I ECSIGNER']"" S MSG(8,1)=" ?? Cosignature not required." Q
. . ; Unsigned, Has EC:
. . S MSG(8,1)=" Cosignature not required. Expected Cosigner deleted."
. . S DR="1208///@;1506///@" D ^DIE S TIUCHNG=1
. . ;
. ; **Cosig REQUIRED:**
. W !!," You may edit the Expected Cosigner:"
. S DR="1208R//;1506////1" D ^DIE
. S NECSIGNR=$P(^TIU(8925,TIUDA,12),U,8)
. I NECSIGNR']"" D Q
. . S MSG(9,1)=" Cosignature is required! Expected Cosigners cannot be alerted "
. . S MSG(9,2)="until they are designated. "
. . I STATUS=6 S MSG(9,3)="Please designate an Expected Cosigner as soon as possible!!"
. I NECSIGNR=ECSIGNER D Q
. . W !!," Expected Cosigner not changed." H 1
. W !!," Expected Cosigner edited." H 1 S TIUCHNG=1 Q
;
; **Docmt is a Discharge Summary. Attending required: **
S ATTEND=$P($G(^TIU(8925,TIUDA,12)),U,9)
W !!,"You may edit the Attending Physician:"
S DR="1209R//" D ^DIE
S NATTEND=$P(^TIU(8925,TIUDA,12),U,9)
S MSG("ALERT")=" Attendings cannot be alerted until designated!"
I NATTEND']0 S MSG(1,1)=" Attending is Required!",MSG(1,2)=MSG("ALERT") G COS1X
; NATTEND is not null. Does it pass screen from TIU*1*219?
; (Needed even after 219 for ^ or Return with no Attending)
; Overwrite most likely msgs with least likely:
I +$$REQCOSIG^TIULP(+NODE0,+TIUDA,NATTEND) S MSG(2,1)=" This person requires a cosignature. Please select a different Attending.",MSG(2,2)=MSG("ALERT")
I '$$ISA^USRLM(NATTEND,"PROVIDER") D
. K MSG(2)
. S MSG(2,1)=" This person is not in User Class PROVIDER. Please check User "
. S MSG(2,2)="Class or select a different Attending."
. S MSG(2,3)=MSG("ALERT")
I $$ISTERM^USRLM(NATTEND) K MSG(2) S MSG(2,1)=" This person is terminated! Please select a different Attending.",MSG(2,2)=MSG("ALERT")
; Att fails. Restore old att:
I $D(MSG(2)) D G COS1X
. S X=$S((STATUS=5)&(ATTEND']""):"@",1:ATTEND),DR="1209////" D ^DIE
; Attending exists and is good:
S NESIGNR=$$WHOSIGNS^TIULC1(DA),NECSIGNR=$$WHOCOSIG^TIULC1(DA)
S DR="1204////^S X=NESIGNR"
S DR=DR_";1208////^S X=NECSIGNR"
S DR=DR_";1506////^S X=$S(+NESIGNR=+NATTEND:0,1:1)"
D ^DIE
I NATTEND=ATTEND D G COS1X
. W !!," Attending Physician not changed." H 1
; New Attend Changed - Go on to audit
W !!," Attending Physician edited." S TIUCHNG=1 H 1
COS1X ;
I $G(TIUCHNG) D
. D SEND^TIUALRT(TIUDA)
. Q:$G(STATUS)'=6 D ; Audit uncosigned docmts only
. S CHKSUM=+$$CHKSUM^TIULC("^TIU(8925,"_+TIUDA_",""TEXT"")")
. D AUDIT^TIUEDI1(TIUDA,CHKSUM,CHKSUM)
I $D(MSG) W ! F MSGNO=1:1:9 D
. F LNO=1:1:10 Q:'$D(MSG(MSGNO,LNO)) W !,MSG(MSGNO,LNO)
I $D(MSG),$$READ^TIUU("EA","RETURN to continue...")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIURA3 6494 printed Oct 16, 2024@18:45:35 Page 2
TIURA3 ; SLC/JER - Review screen actions ; 11/21/07
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**220,234**;Jun 20, 1997;Build 6
+2 ; Call to ISA^USRLM supported by DBIA 2324
+3 ; Call to ISTERM^USRLM supported by DBIA 2712
EDITCOS ; Edit Expected Cosigner
+1 NEW TIUDA,TIUDATA,TIUCHNG,TIUI,DIROUT,TIUDAARY
+2 NEW TIULST,MSGVERB,TIUXNOD
+3 SET TIUXNOD=$GET(XQORNOD(0))
+4 IF $PIECE(TIUXNOD,U,3)="EC"
WRITE "Edit Cosigner",!
SET $PIECE(TIUXNOD,U,4)="EC="_$PIECE($PIECE(TIUXNOD,U,4),"==",2)
+5 SET TIUI=0
+6 IF '$DATA(VALMY)
DO EN^VALM2(TIUXNOD)
+7 FOR
SET TIUI=$ORDER(VALMY(TIUI))
if +TIUI'>0
QUIT
Begin DoDot:1
+8 NEW RSTRCTD
+9 SET TIUDATA=$GET(^TMP("TIURIDX",$JOB,TIUI))
+10 DO CLEAR^VALM1
WRITE !!,"Editing #",+TIUDATA
+11 SET TIUDA=+$PIECE(TIUDATA,U,2)
SET RSTRCTD=$$DOCRES^TIULRR(TIUDA)
+12 IF RSTRCTD
Begin DoDot:2
+13 WRITE !!,$CHAR(7),"Ok, no harm done...",!
+14 ; pause
IF $$READ^TIUU("EA","RETURN to continue...")
End DoDot:2
QUIT
+15 SET TIUDAARY(TIUI)=TIUDA
+16 SET TIUCHNG=0
+17 IF +$DATA(^TIU(8925,+TIUDA,0))
DO EDITCOS1
+18 IF +$GET(TIUCHNG)
Begin DoDot:2
+19 SET TIULST=$GET(TIULST)_$SELECT($GET(TIULST)]"":",",1:"")_TIUI
End DoDot:2
End DoDot:1
if $DATA(DIROUT)
QUIT
+20 ; -- Update or Rebuild list, restore video: --
+21 SET TIUCHNG("UPDATE")=1
+22 DO UPRBLD^TIURL(.TIUCHNG,.VALMY)
KILL VALMY
+23 SET VALMBCK="R"
+24 SET MSGVERB="edited"
+25 DO VMSG^TIURS1($GET(TIULST),.TIUDAARY,MSGVERB)
+26 QUIT
EDITCOS1 ; Edit expected cosigner/attending for single record
+1 ; Receives TIUDA
+2 IF '+$GET(TIUDA)
WRITE !,"No Documents selected."
HANG 2
QUIT
+3 ; Evaluate edit privilege
+4 NEW NODE0,STATUS,OK2CHNG,NODE12,REQCOSIG
+5 NEW ECSIGNER,ESIGNER,OKCLASS,TIUISDS,DA,DR,DIE,X
+6 NEW ALTNODE0,ALTTIUDA,NESIGNR,NECSIGNR,ATTEND,NATTEND,CHKSUM,LNO,MSGNO
+7 NEW CANDO,TIUISCP,TIUISCST,TIUISPN,MSG
+8 ; NECSIGNER,NATTEND etc,(N for new) means post-edit. It may not differ
+9 ;from the original. It may be null if the original was null.
+10 SET NODE0=^TIU(8925,TIUDA,0)
SET STATUS=$PIECE(NODE0,U,5)
SET (OK2CHNG,OKCLASS)=1
+11 SET ALTNODE0=NODE0
SET ALTTIUDA=TIUDA
SET NODE12=$GET(^TIU(8925,TIUDA,12))
+12 IF $$ISADDNDM^TIULC1(TIUDA)
Begin DoDot:1
+13 SET ALTTIUDA=$PIECE(NODE0,U,6)
+14 SET ALTNODE0=^TIU(8925,ALTTIUDA,0)
End DoDot:1
+15 SET TIUISDS=$$ISDS^TIULX(+ALTNODE0)
SET TIUISPN=$$ISPN^TIULX(+ALTNODE0)
+16 SET TIUISCST=$$ISA^TIULX(+ALTNODE0,$$CLASS^TIUCNSLT())
+17 SET TIUISCP=$$ISA^TIULX(+ALTNODE0,$$CLASS^TIUCP())
+18 IF 'TIUISDS
IF 'TIUISPN
IF 'TIUISCST
IF 'TIUISCP
Begin DoDot:1
+19 SET MSG(1,1)=" This action is permitted only for Progress Notes, Discharge"
+20 SET MSG(1,2)="Summaries, Clinical Procedures and Consults."
End DoDot:1
GOTO COS1X
+21 IF STATUS>6
SET MSG(2,1)=" This document has already been Completed!"
GOTO COS1X
+22 IF STATUS<5
SET MSG(3,1)=" This document still needs Release or Verification!"
GOTO COS1X
+23 ; Status = 5 unsigned or 6 uncosigned:
+24 ; Try rules for EDIT COSIGNER:
+25 SET CANDO=$$CANDO^TIULP(TIUDA,"EDIT COSIGNER")
+26 IF 'CANDO
SET MSG(4,1)=" "_$PIECE(CANDO,U,2)
if STATUS=6
GOTO COS1X
+27 ; If docmt is unsigned and EDIT COSIGNER rules failed,
+28 ; try EDIT RECORD rules:
+29 IF STATUS=5
IF 'CANDO
Begin DoDot:1
+30 SET CANDO=$$CANDO^TIULP(TIUDA,"EDIT RECORD")
+31 IF CANDO
KILL MSG(4)
QUIT
+32 SET MSG(5,1)=" You are not authorized to edit any aspect of this document."
End DoDot:1
if 'CANDO
GOTO COS1X
+33 ; User authorized to change Expected Cosigner/attending:
+34 SET DA=TIUDA
SET DIE=8925
+35 ;
+36 ; **Docmt is PN, CP or Consult**
+37 IF 'TIUISDS
Begin DoDot:1
+38 SET ESIGNER=$PIECE(NODE12,U,4)
+39 SET ECSIGNER=$PIECE(NODE12,U,8)
+40 IF ESIGNER'>0
SET MSG(6,1)=" This document has no Expected Signer!"
QUIT
+41 SET REQCOSIG=$$REQCOSIG^TIULP(+NODE0,+TIUDA,ESIGNER)
+42 ;
+43 ; **Cosig NOT REQUIRED:**
+44 IF 'REQCOSIG
Begin DoDot:2
+45 ; Status Uncosigned - Do not permit completion of notes:
+46 IF STATUS=6
Begin DoDot:3
+47 SET MSG(7,1)=" Cosignature is not currently required. This option cannot be"
+48 SET MSG(7,2)="used to change document status to COMPLETED. It looks like the author's"
+49 SET MSG(7,3)="requirement has changed since this document was written."
+50 SET MSG(7,4)="Please contact your CAC and/or HIMS for assistance."
End DoDot:3
QUIT
+51 ; Unsigned, Has no EC:
+52 IF ECSIGNER']""
SET MSG(8,1)=" ?? Cosignature not required."
QUIT
+53 ; Unsigned, Has EC:
+54 SET MSG(8,1)=" Cosignature not required. Expected Cosigner deleted."
+55 SET DR="1208///@;1506///@"
DO ^DIE
SET TIUCHNG=1
+56 ;
End DoDot:2
QUIT
+57 ; **Cosig REQUIRED:**
+58 WRITE !!," You may edit the Expected Cosigner:"
+59 SET DR="1208R//;1506////1"
DO ^DIE
+60 SET NECSIGNR=$PIECE(^TIU(8925,TIUDA,12),U,8)
+61 IF NECSIGNR']""
Begin DoDot:2
+62 SET MSG(9,1)=" Cosignature is required! Expected Cosigners cannot be alerted "
+63 SET MSG(9,2)="until they are designated. "
+64 IF STATUS=6
SET MSG(9,3)="Please designate an Expected Cosigner as soon as possible!!"
End DoDot:2
QUIT
+65 IF NECSIGNR=ECSIGNER
Begin DoDot:2
+66 WRITE !!," Expected Cosigner not changed."
HANG 1
End DoDot:2
QUIT
+67 WRITE !!," Expected Cosigner edited."
HANG 1
SET TIUCHNG=1
QUIT
End DoDot:1
GOTO COS1X
+68 ;
+69 ; **Docmt is a Discharge Summary. Attending required: **
+70 SET ATTEND=$PIECE($GET(^TIU(8925,TIUDA,12)),U,9)
+71 WRITE !!,"You may edit the Attending Physician:"
+72 SET DR="1209R//"
DO ^DIE
+73 SET NATTEND=$PIECE(^TIU(8925,TIUDA,12),U,9)
+74 SET MSG("ALERT")=" Attendings cannot be alerted until designated!"
+75 IF NATTEND']0
SET MSG(1,1)=" Attending is Required!"
SET MSG(1,2)=MSG("ALERT")
GOTO COS1X
+76 ; NATTEND is not null. Does it pass screen from TIU*1*219?
+77 ; (Needed even after 219 for ^ or Return with no Attending)
+78 ; Overwrite most likely msgs with least likely:
+79 IF +$$REQCOSIG^TIULP(+NODE0,+TIUDA,NATTEND)
SET MSG(2,1)=" This person requires a cosignature. Please select a different Attending."
SET MSG(2,2)=MSG("ALERT")
+80 IF '$$ISA^USRLM(NATTEND,"PROVIDER")
Begin DoDot:1
+81 KILL MSG(2)
+82 SET MSG(2,1)=" This person is not in User Class PROVIDER. Please check User "
+83 SET MSG(2,2)="Class or select a different Attending."
+84 SET MSG(2,3)=MSG("ALERT")
End DoDot:1
+85 IF $$ISTERM^USRLM(NATTEND)
KILL MSG(2)
SET MSG(2,1)=" This person is terminated! Please select a different Attending."
SET MSG(2,2)=MSG("ALERT")
+86 ; Att fails. Restore old att:
+87 IF $DATA(MSG(2))
Begin DoDot:1
+88 SET X=$SELECT((STATUS=5)&(ATTEND']""):"@",1:ATTEND)
SET DR="1209////"
DO ^DIE
End DoDot:1
GOTO COS1X
+89 ; Attending exists and is good:
+90 SET NESIGNR=$$WHOSIGNS^TIULC1(DA)
SET NECSIGNR=$$WHOCOSIG^TIULC1(DA)
+91 SET DR="1204////^S X=NESIGNR"
+92 SET DR=DR_";1208////^S X=NECSIGNR"
+93 SET DR=DR_";1506////^S X=$S(+NESIGNR=+NATTEND:0,1:1)"
+94 DO ^DIE
+95 IF NATTEND=ATTEND
Begin DoDot:1
+96 WRITE !!," Attending Physician not changed."
HANG 1
End DoDot:1
GOTO COS1X
+97 ; New Attend Changed - Go on to audit
+98 WRITE !!," Attending Physician edited."
SET TIUCHNG=1
HANG 1
COS1X ;
+1 IF $GET(TIUCHNG)
Begin DoDot:1
+2 DO SEND^TIUALRT(TIUDA)
+3 ; Audit uncosigned docmts only
if $GET(STATUS)'=6
QUIT
Begin DoDot:2
End DoDot:2
+4 SET CHKSUM=+$$CHKSUM^TIULC("^TIU(8925,"_+TIUDA_",""TEXT"")")
+5 DO AUDIT^TIUEDI1(TIUDA,CHKSUM,CHKSUM)
End DoDot:1
+6 IF $DATA(MSG)
WRITE !
FOR MSGNO=1:1:9
Begin DoDot:1
+7 FOR LNO=1:1:10
if '$DATA(MSG(MSGNO,LNO))
QUIT
WRITE !,MSG(MSGNO,LNO)
End DoDot:1
+8 IF $DATA(MSG)
IF $$READ^TIUU("EA","RETURN to continue...")
+9 QUIT
