TIURA2.m

TIURA2 ; SLC/JER - More review screen actions ;26-Mar-2014 17:13;DU

 ;;1.0;TEXT INTEGRATION UTILITIES;**88,58,100,123,1002,112,1009,182,1010,269,1013**;Jun 20, 1997;Build 33

 ; 6/20/00: Moved DISPLAY, BROWSE, & BROWS1 from TIURA to TIURA2

 ;IHS/ITSC/LJF 7/30/2003 bypass rebuild if called by BTIURPT

 ;IHS/OIT/LJF 03/17/2005 PATCH #1002 - added PEP to BROWS1 subroutine

 ;to be called by PCC Audit function

DISPLAY ; Detailed Display

 N TIUDA,TIUD,TIUDATA,TIUI,Y,DIROUT,TIUQUIT,RSTRCTD

 I '$D(VALMY) D EN^VALM2(XQORNOD(0))

 S TIUI=0

 F  S TIUI=$O(VALMY(TIUI)) Q:+TIUI'>0  D  Q:$D(TIUQUIT)

 . N TIUVIEW

 . S TIUDATA=$G(^TMP("TIURIDX",$J,TIUI))

 . D CLEAR^VALM1

 . W !!,"Reviewing #",+TIUDATA

 . S TIUDA=+$P(TIUDATA,U,2)

 . S TIUVIEW=$$CANDO^TIULP(TIUDA,"VIEW")

 . I +TIUVIEW'>0 D  Q

 . . W !!,$C(7),$P(TIUVIEW,U,2),!

 . . I $$READ^TIUU("EA","RETURN to continue...") ; pause

 . . D RESTORE^VALM10(+TIUI)

 . S RSTRCTD=$$DOCRES^TIULRR(TIUDA)

 . I RSTRCTD D  Q

 . . W !!,$C(7),"Ok, no harm done...",!

 . . I $$READ^TIUU("EA","RETURN to continue...") ; pause

 . . D RESTORE^VALM10(+TIUI)

 . D EN^TIUAUDIT

 . I +$G(TIUQUIT) D FIXLSTNW^TIULM Q

 . I TIUI'=$P($G(TIUGLINK),U,2) D RESTORE^VALM10(+TIUI) ; See rtn TIURL

 K VALMY S VALMBCK="R"

 Q

BROWSE(TIULTMP) ; Browse selected documents

 ; TIULTMP is list template name

 N TIUDA,DFN,TIU,TIUCHNG,TIUDATA,TIUI,Y,DIROUT,TIUQUIT

 N TIUGDATA

 I '$D(VALMY) D EN^VALM2(XQORNOD(0))

 S TIUI=0

 F  S TIUI=$O(VALMY(TIUI)) Q:+TIUI'>0  D  Q:$D(TIUQUIT)

 . N TIUVIEW,TIUGACT,RSTRCTD

 . S TIUDATA=$G(^TMP("TIURIDX",$J,TIUI))

 . S TIUDA=+$P(TIUDATA,U,2)

 . S TIUGDATA=$G(^TMP("TIUR",$J,"IDDATA",TIUDA)) ; ID note/entry

 . D CLEAR^VALM1

 . W !!,"Reviewing Item #",TIUI

 . S RSTRCTD=$$DOCRES^TIULRR(TIUDA)

 . I RSTRCTD D  Q

 . . W !!,$C(7),"Ok, no harm done...",!

 . . I $$READ^TIUU("EA","RETURN to continue...") ; pause

 . D BROWS1(TIULTMP,TIUDA,TIUGDATA)

 ; -- Update or Rebuild list: --

 I $G(TIUCHNG("DELETE"))!$G(TIUCHNG("ADDM")) S TIUCHNG("RBLD")=1

 S TIUCHNG("UPDATE")=1 ; default

 ;D UPRBLD^TIURL(.TIUCHNG,.VALMY) K VALMY    ;IHS/ITSC/LJF 7/20/2003

 K VALMY

 S VALMBCK="R"

 Q

GETSORT(PRMSORT,EXPSORT) ; Get order for ID entries

 Q $S($G(EXPSORT)'="":EXPSORT,1:PRMSORT)

 ;

BROWS1(TIULTMP,TIUDA,TIUGDATA) ; PEP Browse single document IHS/OIT/LJF 3/17/2005

 ;  Calls EN^VALM

 N %DT,C,D0,DIQ2,FINISH,TIU,TIUVIEW

 I '$D(TIUGDATA) S TIUGDATA=$$IDDATA^TIURECL1(TIUDA)

 I TIULTMP="TIU COMPLETE NOTES",$P(TIUGDATA,U,2) W !!,"You are completing the PARENT ENTRY of this interdisciplinary note."

 I '$P(TIUGDATA,U,2) D  Q:+TIUVIEW'>0  ;TIU*1*123

 . S TIUVIEW=$$CANDO^TIULP(TIUDA,"VIEW")

 . I +TIUVIEW'>0 D

 . . W !!,$C(7),$P(TIUVIEW,U,2),!

 . . I $$READ^TIUU("EA","RETURN to continue...") ; pause

 I '$D(TIUPRM0)!'$D(TIUPRM1) D SETPARM^TIULE

 D EN^VALM(TIULTMP)

 K ^TMP("TIUVIEW",$J)

 Q

 ;

EXPAND ; Expand/Collapse ID notes, Addenda in lists

 N TIUDNM,TIULNM,TIUSTAT

 D:'$D(VALMY) EN^VALM2(XQORNOD(0))

 I $D(VALMY) D EC^TIURECL(.VALMY)

 W !,"Refreshing the list."

 K VALMY

 S VALMCNT=+$G(@VALMAR@(0))

 S VALMBCK="R"

 Q

 ;

PRNTSCRN(VALMY) ; Evaluate whether a record may be printed

 N TIUI S TIUI=""

 F  S TIUI=$O(VALMY(TIUI)) Q:+TIUI'>0  D  Q:$D(DIROUT)

 . N TIUPMTHD,TIUDTYP,TIUPFHDR,TIUPFNBR,TIUPGRP,TIUPRINT,TIUFLAG,RSTRCTD,TIUTYP

 . S RSTRCTD=0,TIUDATA=$G(^TMP("TIURIDX",$J,TIUI))

 . ; *269 vmp/djh - Check if file exists

 . S TIUDA=+$P(TIUDATA,U,2),TIUTYP=+$G(^TIU(8925,TIUDA,0))

 . Q:TIUTYP'>0

 . ; Evaluate whether user can print record

 . S TIUPRINT=$$CANDO^TIULP(TIUDA,"PRINT RECORD")

 . I +TIUPRINT'>0 D  Q

 . . W !!,"Item #",TIUI,": ",!,$P(TIUPRINT,U,2),!

 . . K VALMY(TIUI)

 . . I $$READ^TIUU("EA","RETURN to continue...")

 . ;-- Add Check for restricted record when available --

 . S DFN=+$P(^TIU(8925,TIUDA,0),U,2)

 . S RSTRCTD=$$PTRES^TIULRR(DFN)

 . I +RSTRCTD D  Q

 . . W !!,"Item #",TIUI," Removed from print list.",!

 . . K VALMY(TIUI)

 . . I $$READ^TIUU("EA","Press RETURN to continue...")

 . I +$G(TIUPFLG) S TIUFLAG=+$$CHARTONE^TIURA1(TIUDA)

 Q

DICTATED ; Mark Document(s) "dictated"

 N TIUCHNG,TIUI,TIUY,Y,DIROUT

 I '$D(VALMY) D EN^VALM2(XQORNOD(0))

 S TIUI=0

 F  S TIUI=$O(VALMY(TIUI)) Q:+TIUI'>0  D  Q:$D(DIROUT)

 . N TIU,DFN,TIUDA,TIUDATA,RSTRCTD

 . S TIUDATA=$G(^TMP("TIURIDX",$J,TIUI))

 . 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

 . D EN^VALM("TIU DOCUMENT DICTATED")

 ; -- Update or Rebuild list: --

 S TIUCHNG("UPDATE")=1

 D UPRBLD^TIURL(.TIUCHNG,.VALMY) K VALMY

 S VALMBCK="R"

 Q

DICTATE1(TIUDA) ; Single record sign on chart

 N DICMSG D FULL^VALM1

 D DICT(TIUDA,.DICMSG)

 W !!,$G(DICMSG(1)),!,$G(DICMSG(2)),! H $S($D(DICMSG(0)):+DICMSG(0),1:3)

 Q

DICT(DA,MSG) ; Mark signed on chart. Edit on-chart signatures.

 N AUTHOR,DIE,DR,Y,TIUSTAT,EXPCSNR,ATTNDNG,TIUDA,TIUPRMT,TIU0,TIU12,TIU13

 S TIU0=$G(^TIU(8925,+DA,0)),TIU12=$G(^(12)),TIU13=$G(^(13))

 S TIUSTAT=$P(TIU0,U,5)

 S TIUPRMT=$S(TIUSTAT>1:"Edit Dictation Data? ",1:"Has this document been dictated? ")

 W ! S MSG=$$READ^TIUU("YAO",TIUPRMT,"NO") W !

 I 'MSG S TIUCHNG=0 G DICTX

 S TIUCHNG=1

 S AUTHOR=$$PERSNAME^TIULC1(+$P(TIU12,U,2))

 S EXPCSNR=$$PERSNAME^TIULC1(+$P(TIU12,U,8))

 S:+$P(TIU12,U,9) ATTNDNG=$$PERSNAME^TIULC1(+$P(TIU12,U,9))

 S DR="1202//^S X=AUTHOR;1307//^S X=$S(+$P(TIU13,U,7)'>0:""NOW"",1:$$DATE^TIULS(+$P(TIU13,U,7),""MM/DD/CCYY@HR:MIN:SEC""))"

 I $D(ATTNDNG) S DR=DR_";1209//^S X=ATTNDNG"

 E  I $D(EXPCSNR) S DR=DR_";1208//^S X=EXPCSNR"

 S DR=DR_";1204////^S X=$$WHOSIGNS^TIULC1(DA);1208////^S X=$$WHOCOSIG^TIULC1(DA)"

 S DIE=8925 D ^DIE

 S TIU0=$G(^TIU(8925,+DA,0)),TIU12=$G(^(12)),TIU13=$G(^(13))

 ;Toggle status between undictated and untranscribed, depending on Dict Date

 S DR=".05///^S X=$S(+$P(TIU13,U,7):""UNTRANSCRIBED"",1:""UNDICTATED"")",DIE=8925 D ^DIE

 D UPDTIRT^TIUDIRT(.TIU,+DA)

DICTX S MSG(1)="  Dictation data "_$S(TIUCHNG:"",1:"NOT ")_"changed."

 Q

TIURA2    ; SLC/JER - More review screen actions ;26-Mar-2014 17:13;DU

 +1       ;;1.0;TEXT INTEGRATION UTILITIES;**88,58,100,123,1002,112,1009,182,1010,269,1013**;Jun 20, 1997;Build 33

 +2       ; 6/20/00: Moved DISPLAY, BROWSE, & BROWS1 from TIURA to TIURA2

 +3       ;IHS/ITSC/LJF 7/30/2003 bypass rebuild if called by BTIURPT

 +4       ;IHS/OIT/LJF 03/17/2005 PATCH #1002 - added PEP to BROWS1 subroutine

 +5       ;to be called by PCC Audit function

DISPLAY   ; Detailed Display

 +1        NEW TIUDA,TIUD,TIUDATA,TIUI,Y,DIROUT,TIUQUIT,RSTRCTD

 +2        IF '$DATA(VALMY)

               DO EN^VALM2(XQORNOD(0))

 +3        SET TIUI=0

 +4        FOR 

               SET TIUI=$ORDER(VALMY(TIUI))

               IF +TIUI'>0

                   QUIT 

               Begin DoDot:1

 +5                NEW TIUVIEW

 +6                SET TIUDATA=$GET(^TMP("TIURIDX",$JOB,TIUI))

 +7                DO CLEAR^VALM1

 +8                WRITE !!,"Reviewing #",+TIUDATA

 +9                SET TIUDA=+$PIECE(TIUDATA,U,2)

 +10               SET TIUVIEW=$$CANDO^TIULP(TIUDA,"VIEW")

 +11               IF +TIUVIEW'>0

                       Begin DoDot:2

 +12                       WRITE !!,$CHAR(7),$PIECE(TIUVIEW,U,2),!

 +13      ; pause

                           IF $$READ^TIUU("EA","RETURN to continue...")

 +14                       DO RESTORE^VALM10(+TIUI)

                       End DoDot:2

                       QUIT 

 +15               SET RSTRCTD=$$DOCRES^TIULRR(TIUDA)

 +16               IF RSTRCTD

                       Begin DoDot:2

 +17                       WRITE !!,$CHAR(7),"Ok, no harm done...",!

 +18      ; pause

                           IF $$READ^TIUU("EA","RETURN to continue...")

 +19                       DO RESTORE^VALM10(+TIUI)

                       End DoDot:2

                       QUIT 

 +20               DO EN^TIUAUDIT

 +21               IF +$GET(TIUQUIT)

                       DO FIXLSTNW^TIULM

                       QUIT 

 +22      ; See rtn TIURL

                   IF TIUI'=$PIECE($GET(TIUGLINK),U,2)

                       DO RESTORE^VALM10(+TIUI)

               End DoDot:1

               IF $DATA(TIUQUIT)

                   QUIT 

 +23       KILL VALMY

           SET VALMBCK="R"

 +24       QUIT 

BROWSE(TIULTMP) ; Browse selected documents

 +1       ; TIULTMP is list template name

 +2        NEW TIUDA,DFN,TIU,TIUCHNG,TIUDATA,TIUI,Y,DIROUT,TIUQUIT

 +3        NEW TIUGDATA

 +4        IF '$DATA(VALMY)

               DO EN^VALM2(XQORNOD(0))

 +5        SET TIUI=0

 +6        FOR 

               SET TIUI=$ORDER(VALMY(TIUI))

               IF +TIUI'>0

                   QUIT 

               Begin DoDot:1

 +7                NEW TIUVIEW,TIUGACT,RSTRCTD

 +8                SET TIUDATA=$GET(^TMP("TIURIDX",$JOB,TIUI))

 +9                SET TIUDA=+$PIECE(TIUDATA,U,2)

 +10      ; ID note/entry

                   SET TIUGDATA=$GET(^TMP("TIUR",$JOB,"IDDATA",TIUDA))

 +11               DO CLEAR^VALM1

 +12               WRITE !!,"Reviewing Item #",TIUI

 +13               SET RSTRCTD=$$DOCRES^TIULRR(TIUDA)

 +14               IF RSTRCTD

                       Begin DoDot:2

 +15                       WRITE !!,$CHAR(7),"Ok, no harm done...",!

 +16      ; pause

                           IF $$READ^TIUU("EA","RETURN to continue...")

                       End DoDot:2

                       QUIT 

 +17               DO BROWS1(TIULTMP,TIUDA,TIUGDATA)

               End DoDot:1

               IF $DATA(TIUQUIT)

                   QUIT 

 +18      ; -- Update or Rebuild list: --

 +19       IF $GET(TIUCHNG("DELETE"))!$GET(TIUCHNG("ADDM"))

               SET TIUCHNG("RBLD")=1

 +20      ; default

           SET TIUCHNG("UPDATE")=1

 +21      ;D UPRBLD^TIURL(.TIUCHNG,.VALMY) K VALMY    ;IHS/ITSC/LJF 7/20/2003

 +22       KILL VALMY

 +23       SET VALMBCK="R"

 +24       QUIT 

GETSORT(PRMSORT,EXPSORT) ; Get order for ID entries

 +1        QUIT $SELECT($GET(EXPSORT)'="":EXPSORT,1:PRMSORT)

 +2       ;

BROWS1(TIULTMP,TIUDA,TIUGDATA) ; PEP Browse single document IHS/OIT/LJF 3/17/2005

 +1       ;  Calls EN^VALM

 +2        NEW %DT,C,D0,DIQ2,FINISH,TIU,TIUVIEW

 +3        IF '$DATA(TIUGDATA)

               SET TIUGDATA=$$IDDATA^TIURECL1(TIUDA)

 +4        IF TIULTMP="TIU COMPLETE NOTES"

               IF $PIECE(TIUGDATA,U,2)

                   WRITE !!,"You are completing the PARENT ENTRY of this interdisciplinary note."

 +5       ;TIU*1*123

           IF '$PIECE(TIUGDATA,U,2)

               Begin DoDot:1

 +6                SET TIUVIEW=$$CANDO^TIULP(TIUDA,"VIEW")

 +7                IF +TIUVIEW'>0

                       Begin DoDot:2

 +8                        WRITE !!,$CHAR(7),$PIECE(TIUVIEW,U,2),!

 +9       ; pause

                           IF $$READ^TIUU("EA","RETURN to continue...")

                       End DoDot:2

               End DoDot:1

               IF +TIUVIEW'>0

                   QUIT 

 +10       IF '$DATA(TIUPRM0)!'$DATA(TIUPRM1)

               DO SETPARM^TIULE

 +11       DO EN^VALM(TIULTMP)

 +12       KILL ^TMP("TIUVIEW",$JOB)

 +13       QUIT 

 +14      ;

EXPAND    ; Expand/Collapse ID notes, Addenda in lists

 +1        NEW TIUDNM,TIULNM,TIUSTAT

 +2        IF '$DATA(VALMY)

               DO EN^VALM2(XQORNOD(0))

 +3        IF $DATA(VALMY)

               DO EC^TIURECL(.VALMY)

 +4        WRITE !,"Refreshing the list."

 +5        KILL VALMY

 +6        SET VALMCNT=+$GET(@VALMAR@(0))

 +7        SET VALMBCK="R"

 +8        QUIT 

 +9       ;

PRNTSCRN(VALMY) ; Evaluate whether a record may be printed

 +1        NEW TIUI

           SET TIUI=""

 +2        FOR 

               SET TIUI=$ORDER(VALMY(TIUI))

               IF +TIUI'>0

                   QUIT 

               Begin DoDot:1

 +3                NEW TIUPMTHD,TIUDTYP,TIUPFHDR,TIUPFNBR,TIUPGRP,TIUPRINT,TIUFLAG,RSTRCTD,TIUTYP

 +4                SET RSTRCTD=0

                   SET TIUDATA=$GET(^TMP("TIURIDX",$JOB,TIUI))

 +5       ; *269 vmp/djh - Check if file exists

 +6                SET TIUDA=+$PIECE(TIUDATA,U,2)

                   SET TIUTYP=+$GET(^TIU(8925,TIUDA,0))

 +7                IF TIUTYP'>0

                       QUIT 

 +8       ; Evaluate whether user can print record

 +9                SET TIUPRINT=$$CANDO^TIULP(TIUDA,"PRINT RECORD")

 +10               IF +TIUPRINT'>0

                       Begin DoDot:2

 +11                       WRITE !!,"Item #",TIUI,": ",!,$PIECE(TIUPRINT,U,2),!

 +12                       KILL VALMY(TIUI)

 +13                       IF $$READ^TIUU("EA","RETURN to continue...")

                       End DoDot:2

                       QUIT 

 +14      ;-- Add Check for restricted record when available --

 +15               SET DFN=+$PIECE(^TIU(8925,TIUDA,0),U,2)

 +16               SET RSTRCTD=$$PTRES^TIULRR(DFN)

 +17               IF +RSTRCTD

                       Begin DoDot:2

 +18                       WRITE !!,"Item #",TIUI," Removed from print list.",!

 +19                       KILL VALMY(TIUI)

 +20                       IF $$READ^TIUU("EA","Press RETURN to continue...")

                       End DoDot:2

                       QUIT 

 +21               IF +$GET(TIUPFLG)

                       SET TIUFLAG=+$$CHARTONE^TIURA1(TIUDA)

               End DoDot:1

               IF $DATA(DIROUT)

                   QUIT 

 +22       QUIT 

DICTATED  ; Mark Document(s) "dictated"

 +1        NEW TIUCHNG,TIUI,TIUY,Y,DIROUT

 +2        IF '$DATA(VALMY)

               DO EN^VALM2(XQORNOD(0))

 +3        SET TIUI=0

 +4        FOR 

               SET TIUI=$ORDER(VALMY(TIUI))

               IF +TIUI'>0

                   QUIT 

               Begin DoDot:1

 +5                NEW TIU,DFN,TIUDA,TIUDATA,RSTRCTD

 +6                SET TIUDATA=$GET(^TMP("TIURIDX",$JOB,TIUI))

 +7                SET TIUDA=+$PIECE(TIUDATA,U,2)

                   SET RSTRCTD=$$DOCRES^TIULRR(TIUDA)

 +8                IF RSTRCTD

                       Begin DoDot:2

 +9                        WRITE !!,$CHAR(7),"Ok, no harm done...",!

 +10      ; pause

                           IF $$READ^TIUU("EA","RETURN to continue...")

                       End DoDot:2

                       QUIT 

 +11               DO EN^VALM("TIU DOCUMENT DICTATED")

               End DoDot:1

               IF $DATA(DIROUT)

                   QUIT 

 +12      ; -- Update or Rebuild list: --

 +13       SET TIUCHNG("UPDATE")=1

 +14       DO UPRBLD^TIURL(.TIUCHNG,.VALMY)

           KILL VALMY

 +15       SET VALMBCK="R"

 +16       QUIT 

DICTATE1(TIUDA) ; Single record sign on chart

 +1        NEW DICMSG

           DO FULL^VALM1

 +2        DO DICT(TIUDA,.DICMSG)

 +3        WRITE !!,$GET(DICMSG(1)),!,$GET(DICMSG(2)),!

           HANG $SELECT($DATA(DICMSG(0)):+DICMSG(0),1:3)

 +4        QUIT 

DICT(DA,MSG) ; Mark signed on chart. Edit on-chart signatures.

 +1        NEW AUTHOR,DIE,DR,Y,TIUSTAT,EXPCSNR,ATTNDNG,TIUDA,TIUPRMT,TIU0,TIU12,TIU13

 +2        SET TIU0=$GET(^TIU(8925,+DA,0))

           SET TIU12=$GET(^(12))

           SET TIU13=$GET(^(13))

 +3        SET TIUSTAT=$PIECE(TIU0,U,5)

 +4        SET TIUPRMT=$SELECT(TIUSTAT>1:"Edit Dictation Data? ",1:"Has this document been dictated? ")

 +5        WRITE !

           SET MSG=$$READ^TIUU("YAO",TIUPRMT,"NO")

           WRITE !

 +6        IF 'MSG

               SET TIUCHNG=0

               GOTO DICTX

 +7        SET TIUCHNG=1

 +8        SET AUTHOR=$$PERSNAME^TIULC1(+$PIECE(TIU12,U,2))

 +9        SET EXPCSNR=$$PERSNAME^TIULC1(+$PIECE(TIU12,U,8))

 +10       IF +$PIECE(TIU12,U,9)

               SET ATTNDNG=$$PERSNAME^TIULC1(+$PIECE(TIU12,U,9))

 +11       SET DR="1202//^S X=AUTHOR;1307//^S X=$S(+$P(TIU13,U,7)'>0:""NOW"",1:$$DATE^TIULS(+$P(TIU13,U,7),""MM/DD/CCYY@HR:MIN:SEC""))"

 +12       IF $DATA(ATTNDNG)

               SET DR=DR_";1209//^S X=ATTNDNG"

 +13      IF '$TEST

               IF $DATA(EXPCSNR)

                   SET DR=DR_";1208//^S X=EXPCSNR"

 +14       SET DR=DR_";1204////^S X=$$WHOSIGNS^TIULC1(DA);1208////^S X=$$WHOCOSIG^TIULC1(DA)"

 +15       SET DIE=8925

           DO ^DIE

 +16       SET TIU0=$GET(^TIU(8925,+DA,0))

           SET TIU12=$GET(^(12))

           SET TIU13=$GET(^(13))

 +17      ;Toggle status between undictated and untranscribed, depending on Dict Date

 +18       SET DR=".05///^S X=$S(+$P(TIU13,U,7):""UNTRANSCRIBED"",1:""UNDICTATED"")"

           SET DIE=8925

           DO ^DIE

 +19       DO UPDTIRT^TIUDIRT(.TIU,+DA)

DICTX      SET MSG(1)="  Dictation data "_$SELECT(TIUCHNG:"",1:"NOT ")_"changed."

 +1        QUIT