| 1 | SROHIS ;BIR/ADM - MOVE REPORTS FOR HISTORICAL CASES TO TIU ; [ 01/22/04  11:19 AM ]
 | 
|---|
| 2 |  ;;3.0; Surgery ;**100**;24 Jun 93
 | 
|---|
| 3 |  ;
 | 
|---|
| 4 |  ;** NOTICE: This routine is part of an implementation of a nationally
 | 
|---|
| 5 |  ;**         controlled procedure.  Local modifications to this routine
 | 
|---|
| 6 |  ;**         are prohibited.
 | 
|---|
| 7 |  ;
 | 
|---|
| 8 |  ; Reference to $$WHATITLE^TIUPUTU supported by DBIA #3351
 | 
|---|
| 9 |  ; Reference to MAKE^TIUSRVP supported by DBIA #3535
 | 
|---|
| 10 |  ; Reference to UPDATE^TIUSRVP supported by DBIA #3535
 | 
|---|
| 11 |  ; Reference to ZTSAVE("DUZ")=.5 supported by SACC exemption
 | 
|---|
| 12 |  ;
 | 
|---|
| 13 |  N SRINST,SRINSTP,SRN,SRRPT,SRPOS,SRSD,SRSDT,SRSOUT,X,Y
 | 
|---|
| 14 | EN S SRSOUT=0 W @IOF,!,"Make Reports Viewable in CPRS",!!
 | 
|---|
| 15 |  W ?3,"This option allows Operation Reports, Nurse Intraoperative Reports,",!,?3,"Anesthesia Reports and Procedure Reports (Non-O.R.) for historical cases"
 | 
|---|
| 16 |  W !,?3,"to be moved into TIU as ""electronically unsigned"" to make them viewable",!,?3,"within the CPRS Surgery tab. Historical cases are cases performed before"
 | 
|---|
| 17 |  W !,?3,"the Surgery Electronic Signature for Operative Reports feature was",!,?3,"implemented.",!
 | 
|---|
| 18 |  W !,?3,"These ""electronically unsigned"" reports will contain a disclaimer",!,?3,"stating: ""This information is provided from historical files and cannot"
 | 
|---|
| 19 |  W !,?3,"be verified that the author has authenticated/approved this information.",!,?3,"The authenticated source document in the patient's medical record should"
 | 
|---|
| 20 |  W !,?3,"be reviewed to ensure that all information concerning this event has been",!,?3,"reviewed or noted.""",!
 | 
|---|
| 21 |  W !,?3,"CAUTION!! This is a system intensive process that creates new documents",!,?3,"in TIU. Please ensure adequate disk space availability before running"
 | 
|---|
| 22 |  W !,?3,"this process. Also, late activity messages may be suppressed by disabling",!,?3,"the mail group defined as the ""Late Activity Mail Group"" while this"
 | 
|---|
| 23 |  W !,?3,"process runs. Upon completion, this mail group must be reestablished.",!
 | 
|---|
| 24 | DATE K DIR S DIR("A")="Enter starting date for reports to be moved",DIR(0)="DO^:DT:AEPX",DIR("?")="Reports for all cases performed on this date to the present will be moved."
 | 
|---|
| 25 |  D ^DIR K DIR I $D(DTOUT)!$D(DUOUT)!'Y G END
 | 
|---|
| 26 |  S SRSD=Y
 | 
|---|
| 27 |  S SRINST=$$INST() G:SRINST="^" END S SRINSTP=$P(SRINST,U),SRINST=$S(SRINST["ALL DIVISIONS":SRINST,1:$P(SRINST,U,2))
 | 
|---|
| 28 |  W ! K DIR S DIR("A")="Do you want to move the Operation Reports (Y/N)? " D ASK G:SRSOUT END S SRRPT(1)=Y
 | 
|---|
| 29 |  W ! K DIR S DIR("A")="Do you want to move the Nurse Intraoperative Reports (Y/N)? " D ASK G:SRSOUT END S SRRPT(2)=Y
 | 
|---|
| 30 |  W ! K DIR S DIR("A")="Do you want to move the Anesthesia Reports (if used) (Y/N)? " D ASK G:SRSOUT END S SRRPT(3)=Y
 | 
|---|
| 31 |  W ! K DIR S DIR("A")="Do you want to move the Procedure Reports (Non-O.R.) (Y/N)? " D ASK G:SRSOUT END S SRRPT(4)=Y W !
 | 
|---|
| 32 |  I 'SRRPT(1),'SRRPT(2),'SRRPT(3),'SRRPT(4) W !,"No reports selected." D PRESS,END Q
 | 
|---|
| 33 |  S Y=SRSD D DD^%DT S SRSDT=Y
 | 
|---|
| 34 |  S DIR("A",1)="The following reports for cases performed "_SRSDT_" to the present",DIR("A",2)="for "_SRINST_" will be moved.",SRN=3
 | 
|---|
| 35 |  I SRRPT(1) S DIR("A",SRN)="   Operation Report",SRN=SRN+1
 | 
|---|
| 36 |  I SRRPT(2) S DIR("A",SRN)="   Nurse Intraoperative Report",SRN=SRN+1
 | 
|---|
| 37 |  I SRRPT(3) S DIR("A",SRN)="   Anesthesia Report",SRN=SRN+1
 | 
|---|
| 38 |  I SRRPT(4) S DIR("A",SRN)="   Procedure Report (Non-O.R.)",SRN=SRN+1
 | 
|---|
| 39 |  S DIR("A",SRN)="",DIR("A")="Is this correct (Y/N)? " D ASK G:SRSOUT END G:'Y EN
 | 
|---|
| 40 |  W ! S ZTRTN="MOVE^SROHIS",ZTDESC="Surgery - Make Reports Viewable in CPRS",ZTIO="",(ZTSAVE("SRSD"),ZTSAVE("SRRPT*"),ZTSAVE("SRINST"),ZTSAVE("SRINSTP"))="",ZTSAVE("DUZ")=.5 D ^%ZTLOAD
 | 
|---|
| 41 |  I $D(ZTSK) W !!,"Queued as task #"_ZTSK
 | 
|---|
| 42 | PRESS W !! S DIR(0)="FOA",DIR("A")="Press RETURN to continue. " D ^DIR
 | 
|---|
| 43 | END W @IOF D ^SRSKILL
 | 
|---|
| 44 |  Q
 | 
|---|
| 45 | INST() ; determine division used by process
 | 
|---|
| 46 |  N SR,SRCNT,SRINST,X S (SRCNT,X)=0 F  S X=$O(^SRO(133,X)) Q:'X  I '$P($G(^SRO(133,X,0)),"^",21) S SRCNT=SRCNT+1
 | 
|---|
| 47 |  I SRCNT=1 S SRINST=$P($$SITE^SROVAR,"^",1,2) Q SRINST
 | 
|---|
| 48 |  W ! K DIR,Y S DIR(0)="YO",DIR("?")="Enter 'Yes' to include all divisions, or 'No' to pick one division",DIR("A")="Move reports for all divisions",DIR("B")="YES" D ^DIR S SRINST=$S($G(Y(0))'="":Y(0),1:"^")
 | 
|---|
| 49 |  I SRINST="YES" S SRINST=$P($$SITE^SROVAR,U,2)_" - ALL DIVISIONS"
 | 
|---|
| 50 |  I SRINST="NO" D LIST^DIC(133,"",".01","B","*","","","","","","SR") W ! D
 | 
|---|
| 51 |  .S X=0 F  S X=$O(SR("DILIST",1,X)) Q:'X  W !,X,". ",SR("DILIST",1,X)
 | 
|---|
| 52 |  .K DIR W ! S DIR(0)="NO^1:"_$P(SR("DILIST",0),U),DIR("A")="Select Number",DIR("?")="Enter the corresponding number of the division for which you want to move reports" D ^DIR K DIR
 | 
|---|
| 53 |  .S:+Y<1 SRINST="^" S:+Y>0 SRINST=SR("DILIST",2,+Y)
 | 
|---|
| 54 |  Q $S(SRINST["ALL DIVISIONS":SRINST,SRINST=U:SRINST,1:$P(^SRO(133,SRINST,0),U)_U_SR("DILIST",1,+Y))
 | 
|---|
| 55 | MOVE ; entry point when queued
 | 
|---|
| 56 |  N DFN,SR0,SRDIV,SRED1,SRLOC,SRSD1,SRTIU,SRTN
 | 
|---|
| 57 |  S SRED1=DT+.9999,SRSD1=SRSD-.0001
 | 
|---|
| 58 |  F  S SRSD1=$O(^SRF("AC",SRSD1)) Q:SRSD1>SRED1!'SRSD1  S SRTN=0 F  S SRTN=$O(^SRF("AC",SRSD1,SRTN)) Q:'SRTN  I $$MANDIV^SROUTL0(SRINSTP,SRTN) D
 | 
|---|
| 59 |  .S SR0=^SRF(SRTN,0),DFN=$P(SR0,"^"),SRDIV=$$SITE^SROUTL0(SRTN)
 | 
|---|
| 60 |  .I $P($G(^SRF(SRTN,"NON")),"^")'="Y" D  Q
 | 
|---|
| 61 |  ..I $P($G(^SRF(SRTN,.2)),"^",12) D
 | 
|---|
| 62 |  ...D LOC^SROESX
 | 
|---|
| 63 |  ...I SRRPT(1),'$P($G(^SRF(SRTN,"TIU")),"^"),$O(^SRF(SRTN,12,0)) D OR
 | 
|---|
| 64 |  ...I SRRPT(2),'$P($G(^SRF(SRTN,"TIU")),"^",2) D NR
 | 
|---|
| 65 |  ...I SRRPT(3),$P($G(^SRF(SRTN,.2)),"^",4),$$INUSE^SROESXA(SRTN),'$P($G(^SRF(SRTN,"TIU")),"^",4) D AR
 | 
|---|
| 66 |  .I SRRPT(4),$P($G(^SRF(SRTN,"NON")),"^",5),'$P($G(^SRF(SRTN,"TIU")),"^",3),$P($G(^SRF(SRTN,"TIU")),"^",5)="",$O(^SRF(SRTN,12,0)) D NONOR
 | 
|---|
| 67 |  I $D(ZTQUEUED) S ZTREQ="@" Q
 | 
|---|
| 68 |  D END
 | 
|---|
| 69 |  Q
 | 
|---|
| 70 | ASK S DIR(0)="YA",DIR("B")="NO" D ^DIR K DIR I $D(DTOUT)!$D(DUOUT) S SRSOUT=1 Q
 | 
|---|
| 71 |  Q
 | 
|---|
| 72 | OR ; create entry in TIU for operation report
 | 
|---|
| 73 |  N SRAY,SRTIU,SRV,SRX,TITLE,VDT,VLOC,VSIT,X
 | 
|---|
| 74 |  S SRX=$$WHATITLE^TIUPUTU("OPERATION REPORT"),TITLE=$P(SRX,"^") I 'TITLE Q
 | 
|---|
| 75 |  S SRAY(.02)=DFN,SRAY(.05)=1,SRAY(1301)=$P(SR0,"^",9),SRAY(1302)=.5,SRAY(1303)="C",SRAY(1405)=SRTN_";SRF(",SRAY(1701)="Case #: "_SRTN
 | 
|---|
| 76 |  D DISCLAIM,DICT
 | 
|---|
| 77 |  S VDT=$P(SR0,"^",9),VLOC=SRLOC,VSIT=""
 | 
|---|
| 78 |  I VLOC S SRAY(1211)=VLOC,VSTR=VLOC_";"_VDT_";E"
 | 
|---|
| 79 |  D MAKE^TIUSRVP(.SRTIU,DFN,TITLE,VDT,VLOC,VSIT,.SRAY,$G(VSTR),1,1) I SRTIU S $P(^SRF(SRTN,"TIU"),"^")=SRTIU D STATUS(7)
 | 
|---|
| 80 |  Q
 | 
|---|
| 81 | NONOR ; create entry in TIU for non-or procedures
 | 
|---|
| 82 |  N SRAY,SRTIU,SRV,SRX,TITLE,VDT,VLOC,VSIT,X
 | 
|---|
| 83 |  D LOC^SROESXP
 | 
|---|
| 84 |  S SRX=$$WHATITLE^TIUPUTU("PROCEDURE REPORT"),TITLE=$P(SRX,"^") I 'TITLE Q
 | 
|---|
| 85 |  S SRAY(.02)=DFN,SRAY(.05)=1,SRAY(1301)=$P(SR0,"^",9),SRAY(1303)="C",SRAY(1405)=SRTN_";SRF(",SRAY(1701)="Case #: "_SRTN
 | 
|---|
| 86 |  D DISCLAIM,DICT
 | 
|---|
| 87 |  S SRV=$P(^SRF(SRTN,"NON"),"^",4),VDT=$S(SRV:SRV,1:$P(SR0,"^",9)),VLOC=SRLOC,VSIT=""
 | 
|---|
| 88 |  I VLOC S SRAY(1211)=VLOC,VSTR=VLOC_";"_VDT_";E"
 | 
|---|
| 89 |  D MAKE^TIUSRVP(.SRTIU,DFN,TITLE,VDT,VLOC,VSIT,.SRAY,$G(VSTR),1,1) I SRTIU S $P(^SRF(SRTN,"TIU"),"^",3)=SRTIU D STATUS(7)
 | 
|---|
| 90 |  Q
 | 
|---|
| 91 | NR ; create entry in TIU for nurse intraoperative report
 | 
|---|
| 92 |  N SRAY,SRTIU,SRTXT,SRV,SRX,TITLE,VDT,VLOC,VSIT,X
 | 
|---|
| 93 |  S SRX=$$WHATITLE^TIUPUTU("NURSE INTRAOPERATIVE REPORT"),TITLE=$P(SRX,"^") I 'TITLE Q
 | 
|---|
| 94 |  S SRAY(.02)=DFN,SRAY(.05)=1,SRAY(1301)=$P(SR0,"^",9),SRAY(1303)="C",SRAY(1405)=SRTN_";SRF(",SRAY(1701)="Case #: "_SRTN
 | 
|---|
| 95 |  D RPT^SRONRPT(SRTN),DISCLAIM
 | 
|---|
| 96 |  S SRL=0,SRTXT=10 F  S SRL=$O(^TMP("SRNIR",$J,SRTN,SRL)) Q:'SRL  S SRAY("TEXT",SRTXT,0)=^TMP("SRNIR",$J,SRTN,SRL),SRTXT=SRTXT+1
 | 
|---|
| 97 |  S VDT=$P(SR0,"^",9),VLOC=SRLOC,VSIT=""
 | 
|---|
| 98 |  I VLOC S SRAY(1211)=VLOC,VSTR=VLOC_";"_VDT_";E"
 | 
|---|
| 99 |  D MAKE^TIUSRVP(.SRTIU,DFN,TITLE,VDT,VLOC,VSIT,.SRAY,$G(VSTR),1,1) I SRTIU S $P(^SRF(SRTN,"TIU"),"^",2)=SRTIU D STATUS(7)
 | 
|---|
| 100 |  K ^TMP("SRNIR",$J,SRTN)
 | 
|---|
| 101 |  Q
 | 
|---|
| 102 | AR ; create entry in TIU for anesthesia report
 | 
|---|
| 103 |  N SRAY,SRTIU,SRTXT,SRV,SRX,TITLE,VDT,VLOC,VSIT,X
 | 
|---|
| 104 |  S SRX=$$WHATITLE^TIUPUTU("ANESTHESIA REPORT"),TITLE=$P(SRX,"^") I 'TITLE Q
 | 
|---|
| 105 |  S SRAY(.02)=DFN,SRAY(.05)=1,SRAY(1301)=$P(SR0,"^",9),SRAY(1303)="C",SRAY(1405)=SRTN_";SRF(",SRAY(1701)="Case #: "_SRTN
 | 
|---|
| 106 |  D RPT^SROANR(SRTN),DISCLAIM
 | 
|---|
| 107 |  S SRL=0,SRTXT=10 F  S SRL=$O(^TMP("SRANE",$J,SRTN,SRL)) Q:'SRL  S SRAY("TEXT",SRTXT,0)=^TMP("SRANE",$J,SRTN,SRL),SRTXT=SRTXT+1
 | 
|---|
| 108 |  S VDT=$P(SR0,"^",9),VLOC=SRLOC,VSIT=""
 | 
|---|
| 109 |  I VLOC S SRAY(1211)=VLOC,VSTR=VLOC_";"_VDT_";E"
 | 
|---|
| 110 |  D MAKE^TIUSRVP(.SRTIU,DFN,TITLE,VDT,VLOC,VSIT,.SRAY,$G(VSTR),1,1) I SRTIU S $P(^SRF(SRTN,"TIU"),"^",4)=SRTIU D STATUS(7)
 | 
|---|
| 111 |  K ^TMP("SRANE",$J,SRTN)
 | 
|---|
| 112 |  Q
 | 
|---|
| 113 | STATUS(SRSTAT) ; update status
 | 
|---|
| 114 |  K SRAY S SRAY(.05)=SRSTAT,(SRAY(1202),SRAY(1204),SRAY(1208),SRAY(1209))="" D UPDATE^TIUSRVP(.SRDOC,SRTIU,.SRAY,1)
 | 
|---|
| 115 |  Q
 | 
|---|
| 116 | DICT ; get summary from surgeon's dictation field in file 130
 | 
|---|
| 117 |  N SRL,SRTXT S SRL=0,SRTXT=10
 | 
|---|
| 118 |  F  S SRL=$O(^SRF(SRTN,12,SRL)) Q:'SRL  S SRAY("TEXT",SRTXT,0)=^SRF(SRTN,12,SRL,0) S SRTXT=SRTXT+1
 | 
|---|
| 119 |  Q
 | 
|---|
| 120 | DISCLAIM ; disclaimer statement
 | 
|---|
| 121 |  S SRAY("TEXT",1,0)=""
 | 
|---|
| 122 |  S SRAY("TEXT",2,0)=" ************************************************************************"
 | 
|---|
| 123 |  S SRAY("TEXT",3,0)=" *  DISCLAIMER: This information is provided from historical files and  *"
 | 
|---|
| 124 |  S SRAY("TEXT",4,0)=" *  cannot be verified that the author has authenticated/approved this  *"
 | 
|---|
| 125 |  S SRAY("TEXT",5,0)=" *  information.  The authenticated source document in the patient's    *"
 | 
|---|
| 126 |  S SRAY("TEXT",6,0)=" *  medical record should be reviewed to ensure that all information    *"
 | 
|---|
| 127 |  S SRAY("TEXT",7,0)=" *  concerning this event has been reviewed or noted.                   *"
 | 
|---|
| 128 |  S SRAY("TEXT",8,0)=SRAY("TEXT",2,0),SRAY("TEXT",9,0)=""
 | 
|---|
| 129 |  Q
 | 
|---|