TIU215R ;VMP/RJT - Utililty to analyze problems cause by PATCH TIU*1.0*215 ; 7/25/2007
;;1.0;TEXT INTEGRATION UTILITIES;**231**;Jun 20, 1997;Build 63
; DBIA 4502 TO ACCESS SURGERY FILE
; DBIA 5025 ACCESS ROUTINE SROANR
; DBIA 5024 ACCESS ROUTINE SRONRP
STRT ;
W !!
EN NEW SRTN,TIUDA,TIUVAL,TIUCHKSU,SRVAL,SRCHKSUM,TIUDT,SRTNA,TIUEND,TIUACNT,TIUER,TIUFDEL,TIUADEL
NEW TIUA,TIUDAD,TIUDFN,TIUDONE,TIUNAM,TIUND,TIUX,TIUERR,SURFNAME,TIUFNAME,TIUPATH,SURFILEN,TIUFILEN
NEW TIUIO,SURIO,TIUCPF,TIUAIO,TIUANAME
S U="^",SURFILEN=1,TIUFILEN=1,TIUACNT=0
K ^TMP("TIUSNIR",$J),^TMP("SRNIR",$J)
S DIR("A")="Enter a begin date to start searching Surgery cases "
S DIR(0)="D^:DT:EX"
D ^DIR
I $D(DIRUT) K DIRUT Q
K DIR
S TIUDT=+Y
S DIR("A")="Enter date patch was backed out"
S DIR(0)="D^"_TIUDT_":DT:EX"
D ^DIR
K DIR
I $D(DIRUT) K DIRUT G STRT
S TIUEND=+Y
S DIR("A")="Enter the maximum number of cases per file"
S DIR(0)="N^5:50"
D ^DIR
K DIR
I $D(DIRUT) K DIRUT G STRT
S TIUCPF=Y
PATH ;
K TIUFDEL
S DIR("A")="Enter the path of the output files"
S DIR(0)="F"
S DIR("?")=" "
S DIR("?",1)="Enter file path as USER$:[<DIRECTORY NAME>]"
D ^DIR
I $D(DIRUT) K DIRUT G STRT
S TIUPATH=Y
K DIR
S DIR("A")="Surgery output file (without file extension)"
S DIR(0)="F"
D ^DIR
K DIR
I $D(DIRUT) K DIRUT G PATH
S SURFNAME=Y
D OPENS I POP'=0 G PATH
S TIUFDEL(SURFNAME_SURFILEN_".TXT")=""
D CLOSE^%ZISH("SUR"_SURFILEN)
S DIR("A")="TIU output file (without file extension)"
S DIR(0)="F"
D ^DIR I $D(DIRUT) S TIUER=$$DEL^%ZISH(TIUPATH,$NA(TIUFDEL)) D ERR:'TIUER K DIR,DIRUT G PATH
S TIUFNAME=Y
K DIR
D OPENT I POP'=0 S TIUER=$$DEL^%ZISH(TIUPATH,$NA(TIUFDEL)) D ERR:'TIUER K DIR G PATH
S TIUFDEL(TIUFNAME_TIUFILEN_".TXT")=""
D CLOSE^%ZISH("TIU"_TIUFILEN)
S DIR("A")="TIU Addenda output file (without file extension)"
S DIR(0)="F"
D ^DIR I $D(DIRUT) S TIUER=$$DEL^%ZISH(TIUPATH,$NA(TIUFDEL)) D ERR:'TIUER K DIR,DIRUT G PATH
S TIUANAME=Y
K DIR
D OPENA I POP'=0 S TIUER=$$DEL^%ZISH(TIUPATH,$NA(TIUFDEL)) D ERR:'TIUER K DIR G PATH
S TIUADEL(TIUANAME_TIUFILEN_".TXT")=""
D CLOSE^%ZISH("TIUA"_TIUFILEN)
W !!!,"Processing...",!
S TIUIO=TIUPATH_TIUFNAME,SURIO=TIUPATH_SURFNAME,TIUAIO=TIUPATH_TIUANAME
K TIUFDEL
EN1 ;
NEW TIUCNT,TIURECNT,SURRECNT,TIUCOUNT,SURDT,SURDONE S TIUCNT=0,TIURECNT=0,SURRECNT=0,TIUCOUNT=0
; LOOP THROUGH SURGERY CASES WITHIN DATE RANGE
S (TIUDT,SURDT)=TIUDT-.0001
F S SURDT=$O(^SRF("AC",SURDT)) Q:'$L(SURDT) Q:SURDT\1>TIUEND D
. S TIUA=0 F S TIUA=$O(^SRF("AC",SURDT,TIUA)) Q:TIUA'>0 D
. . S SURDONE="" D CHK,CHK1
I TIUACNT=0 S TIUER=$$DEL^%ZISH(TIUPATH,$NA(TIUADEL))
EN2 ;
W !,"There were "_TIUCOUNT_" records found to be discrepant.",!
Q
; BUILD TMP GLOBALS AND COMPARE NIR CASES
CHK S SRTN=TIUA
S TIUDA=$P($G(^SRF(SRTN,"TIU")),"^",2)
Q:+TIUDA'>0
;DONT EVALUATE UNDICTATED
Q:$P($G(^TIU(8925,TIUDA,0)),U,5)=1
S TIUDFN=$P($G(^TIU(8925,TIUDA,0)),U,2)
K ^TMP("TIUSNIR",$J),^TMP("SRNIR",$J)
D RPT^SRONRPT(SRTN)
;STRIP OUT SUBFILE DATA
S TIUX=0
F S TIUX=$O(^TIU(8925,+TIUDA,"TEXT",TIUX)) Q:TIUX="" D
. S ^TMP("TIUSNIR",$J,TIUDA,TIUX)=$G(^TIU(8925,+TIUDA,"TEXT",TIUX,0))
S TIUVAL="^TMP(""TIUSNIR"","_$J_","_+TIUDA_")"
S TIUCHKSU=$$CHKSUM^XUSESIG1(TIUVAL)
S SRVAL="^TMP(""SRNIR"","_$J_","_+SRTN_")"
S SRCHKSUM=$$CHKSUM^XUSESIG1(SRVAL)
I $G(TIUCHKSU)=$G(SRCHKSUM) Q
D NRPT
S TIURECNT=TIURECNT+1,SURRECNT=SURRECNT+1,TIUCOUNT=TIUCOUNT+1
K @TIUVAL,@SRVAL
Q
CHK1 ; COMPARE ANESTHESIA REPORTS
S TIUDA=$P($G(^SRF(SRTN,"TIU")),"^",4)
Q:+TIUDA'>0
;DONT EVALUATE UNDICTATED
Q:$P($G(^TIU(8925,TIUDA,0)),U,5)=1
K ^TMP("TIUSRANE",$J),^TMP("SRANE",$J)
D RPT^SROANR(SRTN)
;STRIP OUT SUBFILE DATA
S TIUX=0
F S TIUX=$O(^TIU(8925,+TIUDA,"TEXT",TIUX)) Q:TIUX="" D
. S ^TMP("TIUSRANE",$J,TIUDA,TIUX)=$G(^TIU(8925,+TIUDA,"TEXT",TIUX,0))
S TIUVAL="^TMP(""TIUSRANE"","_$J_","_+TIUDA_")"
S TIUCHKSU=$$CHKSUM^XUSESIG1(TIUVAL)
S SRVAL="^TMP(""SRANE"","_$J_","_+SRTN_")"
S SRCHKSUM=$$CHKSUM^XUSESIG1(SRVAL)
I $G(TIUCHKSU)=$G(SRCHKSUM) Q
D ARPT
S TIURECNT=TIURECNT+1,SURRECNT=SURRECNT+1,TIUCOUNT=TIUCOUNT+1
K @TIUVAL,@SRVAL
Q
NRPT D RPT^SRONRPT(SRTN) S DFN=$P(^SRF(SRTN,0),"^")
D SRHDR
D:SURRECNT=TIUCPF NEWSFILE
;D CLOSE^%ZISH("TIU"_TIUFILEN)
D OPEN^%ZISH("SUR"_SURFILEN,TIUPATH,SURFNAME_SURFILEN_".TXT","A")
U SURIO_SURFILEN_".TXT"
W !!!!!!,SRHDR
W !,?4,"PRINTED BY TIU215R UTILITY***** NURSE INTRAOPERATIVE REPORT - CASE #"_SRTN
S SRI=0 F S SRI=$O(^TMP("SRNIR",$J,SRTN,SRI)) Q:'SRI D
.W !,^TMP("SRNIR",$J,SRTN,SRI),!
D SRHDR
D:TIURECNT=TIUCPF NEWTFILE
D CLOSE^%ZISH("SUR"_SURFILEN)
D OPEN^%ZISH("TIU"_TIUFILEN,TIUPATH,TIUFNAME_TIUFILEN_".TXT","A")
U TIUIO_TIUFILEN_".TXT"
I +TIUDA'>0 G NE
W !!!!!!,SRHDR
W !,?4,"PRINTED BY TIU215R UTILITY***** NURSE INTRAOPERATIVE REPORT - CASE #"_SRTN
S SRI=0 F S SRI=$O(^TMP("TIUSNIR",$J,TIUDA,SRI)) Q:'SRI D
.W !,^TMP("TIUSNIR",$J,TIUDA,SRI),!
S TIUDAD=$O(^TIU(8925,"DAD",TIUDA,0))
I +TIUDAD>0 D CLOSE^%ZISH("TIU"_TIUFILEN),ADDENDA
NE D CLOSE^%ZISH("TIU"_TIUFILEN)
D KIL
Q
ARPT ;
D SRHDR
D:SURRECNT=TIUCPF NEWSFILE
;D CLOSE^%ZISH("TIU"_TIUFILEN)
D OPEN^%ZISH("SUR"_SURFILEN,TIUPATH,SURFNAME_SURFILEN_".TXT","A")
U SURIO_SURFILEN_".TXT"
W !,SRHDR
W !,?3,"PRINTED BY TIU215R UTILITY***** ANESTHESIA REPORT - CASE #"_SRTN
D RPT^SROANR(SRTN)
S DFN=$P(^SRF(SRTN,0),"^")
S SRI=0 F S SRI=$O(^TMP("SRANE",$J,SRTN,SRI)) Q:'SRI D
.W !,^TMP("SRANE",$J,SRTN,SRI),!
D SRHDR
D:TIURECNT=TIUCPF NEWTFILE
D CLOSE^%ZISH("SUR"_SURFILEN)
D OPEN^%ZISH("TIU"_TIUFILEN,TIUPATH,TIUFNAME_TIUFILEN_".TXT","A")
U TIUIO_TIUFILEN_".TXT"
I +TIUDA'>0 G AE
W !!!!!!,SRHDR
W !,?3,"PRINTED BY TIU215R UTILITY***** ANESTHESIA REPORT - CASE #"_SRTN
S SRI=0 F S SRI=$O(^TMP("TIUSRANE",$J,TIUDA,SRI)) Q:'SRI D
.W !,^TMP("TIUSRANE",$J,TIUDA,SRI),!
S TIUDAD=$O(^TIU(8925,"DAD",TIUDA,0))
I +TIUDAD>0 D CLOSE^%ZISH("TIU"_TIUFILEN),ADDENDA
AE D CLOSE^%ZISH("TIU"_TIUFILEN)
D KIL
Q
KIL K SRHDR,SRI,SRSDATE,VADM,VA,POP,VAINDT
Q
ERR W !,"UNABLE TO CLEAN UP FILES ON ^ ABORT" Q
SRHDR NEW DFN,Y
S DFN=$P(^SRF(SRTN,0),"^") D DEM^VADPT
S Y=$E($P(^SRF(SRTN,0),"^",9),1,7) D D^DIQ S SRSDATE=Y
S SRHDR=" "_VADM(1)_" ("_VA("PID")_") Case #"_SRTN_" - "_SRSDATE
Q
ADDENDA ;
N TIUI,TIUDAD S TIUI=0,TIUDAD=0,TIUACNT=1
D OPEN^%ZISH("TIUA"_TIUFILEN,TIUPATH,TIUANAME_TIUFILEN_".TXT","A")
U TIUAIO_TIUFILEN_".TXT"
W !!!!,"**************************************************************************",!,SRHDR
W !,?4,"PRINTED BY TIU215F UTILITY***** TIU ADDENDA - CASE #"_SRTN,!,"**************************************************************************",!
; Loop through all addenda for that note
F S TIUDAD=$O(^TIU(8925,"DAD",TIUDA,TIUDAD)) Q:TIUDAD'>0 D
. W !!,?2,"ADDENDUM #"_TIUDAD,!,?2,"-----------------------------------------" S TIUI=0
. ; Loop through entire addendum
. F S TIUI=$O(^TIU(8925,TIUDAD,"TEXT",TIUI)) Q:TIUI'>0 D
. . W !,$G(^TIU(8925,TIUDAD,"TEXT",TIUI,0))
D CLOSE^%ZISH("TIUA"_TIUFILEN)
Q
NEWSFILE ;
D CLOSE^%ZISH("SUR"_SURFILEN) S SURFILEN=SURFILEN+1,SURRECNT=0
D OPEN^%ZISH("SUR"_SURFILEN,TIUPATH,SURFNAME_SURFILEN_".TXT","W")
Q
NEWTFILE ;
D CLOSE^%ZISH("TIU"_TIUFILEN) S TIUFILEN=TIUFILEN+1,TIURECNT=0
D OPEN^%ZISH("TIU"_TIUFILEN,TIUPATH,TIUFNAME_TIUFILEN_".TXT","W")
Q
OPENS ;
D OPEN^%ZISH("SUR"_SURFILEN,TIUPATH,SURFNAME_SURFILEN_".TXT","W")
I POP'=0 W !,"Error opening Surgery output file.",!
Q
OPENT ;
D OPEN^%ZISH("TIU"_TIUFILEN,TIUPATH,TIUFNAME_TIUFILEN_".TXT","W")
I POP'=0 W !,"Error opening TIU output file.",!
Q
OPENA ;
D OPEN^%ZISH("TIUA"_TIUFILEN,TIUPATH,TIUANAME_TIUFILEN_".TXT","W")
I POP'=0 W !,"Error opening TIU Addendum output file.",!
Q
TIU215R ;VMP/RJT - Utililty to analyze problems cause by PATCH TIU*1.0*215 ; 7/25/2007
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**231**;Jun 20, 1997;Build 63
+2 ; DBIA 4502 TO ACCESS SURGERY FILE
+3 ; DBIA 5025 ACCESS ROUTINE SROANR
+4 ; DBIA 5024 ACCESS ROUTINE SRONRP
STRT ;
+1 WRITE !!
EN NEW SRTN,TIUDA,TIUVAL,TIUCHKSU,SRVAL,SRCHKSUM,TIUDT,SRTNA,TIUEND,TIUACNT,TIUER,TIUFDEL,TIUADEL
+1 NEW TIUA,TIUDAD,TIUDFN,TIUDONE,TIUNAM,TIUND,TIUX,TIUERR,SURFNAME,TIUFNAME,TIUPATH,SURFILEN,TIUFILEN
+2 NEW TIUIO,SURIO,TIUCPF,TIUAIO,TIUANAME
+3 SET U="^"
SET SURFILEN=1
SET TIUFILEN=1
SET TIUACNT=0
+4 KILL ^TMP("TIUSNIR",$JOB),^TMP("SRNIR",$JOB)
+5 SET DIR("A")="Enter a begin date to start searching Surgery cases "
+6 SET DIR(0)="D^:DT:EX"
+7 DO ^DIR
+8 IF $DATA(DIRUT)
KILL DIRUT
QUIT
+9 KILL DIR
+10 SET TIUDT=+Y
+11 SET DIR("A")="Enter date patch was backed out"
+12 SET DIR(0)="D^"_TIUDT_":DT:EX"
+13 DO ^DIR
+14 KILL DIR
+15 IF $DATA(DIRUT)
KILL DIRUT
GOTO STRT
+16 SET TIUEND=+Y
+17 SET DIR("A")="Enter the maximum number of cases per file"
+18 SET DIR(0)="N^5:50"
+19 DO ^DIR
+20 KILL DIR
+21 IF $DATA(DIRUT)
KILL DIRUT
GOTO STRT
+22 SET TIUCPF=Y
PATH ;
+1 KILL TIUFDEL
+2 SET DIR("A")="Enter the path of the output files"
+3 SET DIR(0)="F"
+4 SET DIR("?")=" "
+5 SET DIR("?",1)="Enter file path as USER$:[<DIRECTORY NAME>]"
+6 DO ^DIR
+7 IF $DATA(DIRUT)
KILL DIRUT
GOTO STRT
+8 SET TIUPATH=Y
+9 KILL DIR
+10 SET DIR("A")="Surgery output file (without file extension)"
+11 SET DIR(0)="F"
+12 DO ^DIR
+13 KILL DIR
+14 IF $DATA(DIRUT)
KILL DIRUT
GOTO PATH
+15 SET SURFNAME=Y
+16 DO OPENS
IF POP'=0
GOTO PATH
+17 SET TIUFDEL(SURFNAME_SURFILEN_".TXT")=""
+18 DO CLOSE^%ZISH("SUR"_SURFILEN)
+19 SET DIR("A")="TIU output file (without file extension)"
+20 SET DIR(0)="F"
+21 DO ^DIR
IF $DATA(DIRUT)
SET TIUER=$$DEL^%ZISH(TIUPATH,$NAME(TIUFDEL))
IF 'TIUER
DO ERR
KILL DIR,DIRUT
GOTO PATH
+22 SET TIUFNAME=Y
+23 KILL DIR
+24 DO OPENT
IF POP'=0
SET TIUER=$$DEL^%ZISH(TIUPATH,$NAME(TIUFDEL))
IF 'TIUER
DO ERR
KILL DIR
GOTO PATH
+25 SET TIUFDEL(TIUFNAME_TIUFILEN_".TXT")=""
+26 DO CLOSE^%ZISH("TIU"_TIUFILEN)
+27 SET DIR("A")="TIU Addenda output file (without file extension)"
+28 SET DIR(0)="F"
+29 DO ^DIR
IF $DATA(DIRUT)
SET TIUER=$$DEL^%ZISH(TIUPATH,$NAME(TIUFDEL))
IF 'TIUER
DO ERR
KILL DIR,DIRUT
GOTO PATH
+30 SET TIUANAME=Y
+31 KILL DIR
+32 DO OPENA
IF POP'=0
SET TIUER=$$DEL^%ZISH(TIUPATH,$NAME(TIUFDEL))
IF 'TIUER
DO ERR
KILL DIR
GOTO PATH
+33 SET TIUADEL(TIUANAME_TIUFILEN_".TXT")=""
+34 DO CLOSE^%ZISH("TIUA"_TIUFILEN)
+35 WRITE !!!,"Processing...",!
+36 SET TIUIO=TIUPATH_TIUFNAME
SET SURIO=TIUPATH_SURFNAME
SET TIUAIO=TIUPATH_TIUANAME
+37 KILL TIUFDEL
EN1 ;
+1 NEW TIUCNT,TIURECNT,SURRECNT,TIUCOUNT,SURDT,SURDONE
SET TIUCNT=0
SET TIURECNT=0
SET SURRECNT=0
SET TIUCOUNT=0
+2 ; LOOP THROUGH SURGERY CASES WITHIN DATE RANGE
+3 SET (TIUDT,SURDT)=TIUDT-.0001
+4 FOR
SET SURDT=$ORDER(^SRF("AC",SURDT))
IF '$LENGTH(SURDT)
QUIT
IF SURDT\1>TIUEND
QUIT
Begin DoDot:1
+5 SET TIUA=0
FOR
SET TIUA=$ORDER(^SRF("AC",SURDT,TIUA))
IF TIUA'>0
QUIT
Begin DoDot:2
+6 SET SURDONE=""
DO CHK
DO CHK1
End DoDot:2
End DoDot:1
+7 IF TIUACNT=0
SET TIUER=$$DEL^%ZISH(TIUPATH,$NAME(TIUADEL))
EN2 ;
+1 WRITE !,"There were "_TIUCOUNT_" records found to be discrepant.",!
+2 QUIT
+3 ; BUILD TMP GLOBALS AND COMPARE NIR CASES
CHK SET SRTN=TIUA
+1 SET TIUDA=$PIECE($GET(^SRF(SRTN,"TIU")),"^",2)
+2 IF +TIUDA'>0
QUIT
+3 ;DONT EVALUATE UNDICTATED
+4 IF $PIECE($GET(^TIU(8925,TIUDA,0)),U,5)=1
QUIT
+5 SET TIUDFN=$PIECE($GET(^TIU(8925,TIUDA,0)),U,2)
+6 KILL ^TMP("TIUSNIR",$JOB),^TMP("SRNIR",$JOB)
+7 DO RPT^SRONRPT(SRTN)
+8 ;STRIP OUT SUBFILE DATA
+9 SET TIUX=0
+10 FOR
SET TIUX=$ORDER(^TIU(8925,+TIUDA,"TEXT",TIUX))
IF TIUX=""
QUIT
Begin DoDot:1
+11 SET ^TMP("TIUSNIR",$JOB,TIUDA,TIUX)=$GET(^TIU(8925,+TIUDA,"TEXT",TIUX,0))
End DoDot:1
+12 SET TIUVAL="^TMP(""TIUSNIR"","_$JOB_","_+TIUDA_")"
+13 SET TIUCHKSU=$$CHKSUM^XUSESIG1(TIUVAL)
+14 SET SRVAL="^TMP(""SRNIR"","_$JOB_","_+SRTN_")"
+15 SET SRCHKSUM=$$CHKSUM^XUSESIG1(SRVAL)
+16 IF $GET(TIUCHKSU)=$GET(SRCHKSUM)
QUIT
+17 DO NRPT
+18 SET TIURECNT=TIURECNT+1
SET SURRECNT=SURRECNT+1
SET TIUCOUNT=TIUCOUNT+1
+19 KILL @TIUVAL,@SRVAL
+20 QUIT
CHK1 ; COMPARE ANESTHESIA REPORTS
+1 SET TIUDA=$PIECE($GET(^SRF(SRTN,"TIU")),"^",4)
+2 IF +TIUDA'>0
QUIT
+3 ;DONT EVALUATE UNDICTATED
+4 IF $PIECE($GET(^TIU(8925,TIUDA,0)),U,5)=1
QUIT
+5 KILL ^TMP("TIUSRANE",$JOB),^TMP("SRANE",$JOB)
+6 DO RPT^SROANR(SRTN)
+7 ;STRIP OUT SUBFILE DATA
+8 SET TIUX=0
+9 FOR
SET TIUX=$ORDER(^TIU(8925,+TIUDA,"TEXT",TIUX))
IF TIUX=""
QUIT
Begin DoDot:1
+10 SET ^TMP("TIUSRANE",$JOB,TIUDA,TIUX)=$GET(^TIU(8925,+TIUDA,"TEXT",TIUX,0))
End DoDot:1
+11 SET TIUVAL="^TMP(""TIUSRANE"","_$JOB_","_+TIUDA_")"
+12 SET TIUCHKSU=$$CHKSUM^XUSESIG1(TIUVAL)
+13 SET SRVAL="^TMP(""SRANE"","_$JOB_","_+SRTN_")"
+14 SET SRCHKSUM=$$CHKSUM^XUSESIG1(SRVAL)
+15 IF $GET(TIUCHKSU)=$GET(SRCHKSUM)
QUIT
+16 DO ARPT
+17 SET TIURECNT=TIURECNT+1
SET SURRECNT=SURRECNT+1
SET TIUCOUNT=TIUCOUNT+1
+18 KILL @TIUVAL,@SRVAL
+19 QUIT
NRPT DO RPT^SRONRPT(SRTN)
SET DFN=$PIECE(^SRF(SRTN,0),"^")
+1 DO SRHDR
+2 IF SURRECNT=TIUCPF
DO NEWSFILE
+3 ;D CLOSE^%ZISH("TIU"_TIUFILEN)
+4 DO OPEN^%ZISH("SUR"_SURFILEN,TIUPATH,SURFNAME_SURFILEN_".TXT","A")
+5 USE SURIO_SURFILEN_".TXT"
+6 WRITE !!!!!!,SRHDR
+7 WRITE !,?4,"PRINTED BY TIU215R UTILITY***** NURSE INTRAOPERATIVE REPORT - CASE #"_SRTN
+8 SET SRI=0
FOR
SET SRI=$ORDER(^TMP("SRNIR",$JOB,SRTN,SRI))
IF 'SRI
QUIT
Begin DoDot:1
+9 WRITE !,^TMP("SRNIR",$JOB,SRTN,SRI),!
End DoDot:1
+10 DO SRHDR
+11 IF TIURECNT=TIUCPF
DO NEWTFILE
+12 DO CLOSE^%ZISH("SUR"_SURFILEN)
+13 DO OPEN^%ZISH("TIU"_TIUFILEN,TIUPATH,TIUFNAME_TIUFILEN_".TXT","A")
+14 USE TIUIO_TIUFILEN_".TXT"
+15 IF +TIUDA'>0
GOTO NE
+16 WRITE !!!!!!,SRHDR
+17 WRITE !,?4,"PRINTED BY TIU215R UTILITY***** NURSE INTRAOPERATIVE REPORT - CASE #"_SRTN
+18 SET SRI=0
FOR
SET SRI=$ORDER(^TMP("TIUSNIR",$JOB,TIUDA,SRI))
IF 'SRI
QUIT
Begin DoDot:1
+19 WRITE !,^TMP("TIUSNIR",$JOB,TIUDA,SRI),!
End DoDot:1
+20 SET TIUDAD=$ORDER(^TIU(8925,"DAD",TIUDA,0))
+21 IF +TIUDAD>0
DO CLOSE^%ZISH("TIU"_TIUFILEN)
DO ADDENDA
NE DO CLOSE^%ZISH("TIU"_TIUFILEN)
+1 DO KIL
+2 QUIT
ARPT ;
+1 DO SRHDR
+2 IF SURRECNT=TIUCPF
DO NEWSFILE
+3 ;D CLOSE^%ZISH("TIU"_TIUFILEN)
+4 DO OPEN^%ZISH("SUR"_SURFILEN,TIUPATH,SURFNAME_SURFILEN_".TXT","A")
+5 USE SURIO_SURFILEN_".TXT"
+6 WRITE !,SRHDR
+7 WRITE !,?3,"PRINTED BY TIU215R UTILITY***** ANESTHESIA REPORT - CASE #"_SRTN
+8 DO RPT^SROANR(SRTN)
+9 SET DFN=$PIECE(^SRF(SRTN,0),"^")
+10 SET SRI=0
FOR
SET SRI=$ORDER(^TMP("SRANE",$JOB,SRTN,SRI))
IF 'SRI
QUIT
Begin DoDot:1
+11 WRITE !,^TMP("SRANE",$JOB,SRTN,SRI),!
End DoDot:1
+12 DO SRHDR
+13 IF TIURECNT=TIUCPF
DO NEWTFILE
+14 DO CLOSE^%ZISH("SUR"_SURFILEN)
+15 DO OPEN^%ZISH("TIU"_TIUFILEN,TIUPATH,TIUFNAME_TIUFILEN_".TXT","A")
+16 USE TIUIO_TIUFILEN_".TXT"
+17 IF +TIUDA'>0
GOTO AE
+18 WRITE !!!!!!,SRHDR
+19 WRITE !,?3,"PRINTED BY TIU215R UTILITY***** ANESTHESIA REPORT - CASE #"_SRTN
+20 SET SRI=0
FOR
SET SRI=$ORDER(^TMP("TIUSRANE",$JOB,TIUDA,SRI))
IF 'SRI
QUIT
Begin DoDot:1
+21 WRITE !,^TMP("TIUSRANE",$JOB,TIUDA,SRI),!
End DoDot:1
+22 SET TIUDAD=$ORDER(^TIU(8925,"DAD",TIUDA,0))
+23 IF +TIUDAD>0
DO CLOSE^%ZISH("TIU"_TIUFILEN)
DO ADDENDA
AE DO CLOSE^%ZISH("TIU"_TIUFILEN)
+1 DO KIL
+2 QUIT
KIL KILL SRHDR,SRI,SRSDATE,VADM,VA,POP,VAINDT
+1 QUIT
ERR WRITE !,"UNABLE TO CLEAN UP FILES ON ^ ABORT"
QUIT
SRHDR NEW DFN,Y
+1 SET DFN=$PIECE(^SRF(SRTN,0),"^")
DO DEM^VADPT
+2 SET Y=$EXTRACT($PIECE(^SRF(SRTN,0),"^",9),1,7)
DO D^DIQ
SET SRSDATE=Y
+3 SET SRHDR=" "_VADM(1)_" ("_VA("PID")_") Case #"_SRTN_" - "_SRSDATE
+4 QUIT
ADDENDA ;
+1 NEW TIUI,TIUDAD
SET TIUI=0
SET TIUDAD=0
SET TIUACNT=1
+2 DO OPEN^%ZISH("TIUA"_TIUFILEN,TIUPATH,TIUANAME_TIUFILEN_".TXT","A")
+3 USE TIUAIO_TIUFILEN_".TXT"
+4 WRITE !!!!,"**************************************************************************",!,SRHDR
+5 WRITE !,?4,"PRINTED BY TIU215F UTILITY***** TIU ADDENDA - CASE #"_SRTN,!,"**************************************************************************",!
+6 ; Loop through all addenda for that note
+7 FOR
SET TIUDAD=$ORDER(^TIU(8925,"DAD",TIUDA,TIUDAD))
IF TIUDAD'>0
QUIT
Begin DoDot:1
+8 WRITE !!,?2,"ADDENDUM #"_TIUDAD,!,?2,"-----------------------------------------"
SET TIUI=0
+9 ; Loop through entire addendum
+10 FOR
SET TIUI=$ORDER(^TIU(8925,TIUDAD,"TEXT",TIUI))
IF TIUI'>0
QUIT
Begin DoDot:2
+11 WRITE !,$GET(^TIU(8925,TIUDAD,"TEXT",TIUI,0))
End DoDot:2
End DoDot:1
+12 DO CLOSE^%ZISH("TIUA"_TIUFILEN)
+13 QUIT
NEWSFILE ;
+1 DO CLOSE^%ZISH("SUR"_SURFILEN)
SET SURFILEN=SURFILEN+1
SET SURRECNT=0
+2 DO OPEN^%ZISH("SUR"_SURFILEN,TIUPATH,SURFNAME_SURFILEN_".TXT","W")
+3 QUIT
NEWTFILE ;
+1 DO CLOSE^%ZISH("TIU"_TIUFILEN)
SET TIUFILEN=TIUFILEN+1
SET TIURECNT=0
+2 DO OPEN^%ZISH("TIU"_TIUFILEN,TIUPATH,TIUFNAME_TIUFILEN_".TXT","W")
+3 QUIT
OPENS ;
+1 DO OPEN^%ZISH("SUR"_SURFILEN,TIUPATH,SURFNAME_SURFILEN_".TXT","W")
+2 IF POP'=0
WRITE !,"Error opening Surgery output file.",!
+3 QUIT
OPENT ;
+1 DO OPEN^%ZISH("TIU"_TIUFILEN,TIUPATH,TIUFNAME_TIUFILEN_".TXT","W")
+2 IF POP'=0
WRITE !,"Error opening TIU output file.",!
+3 QUIT
OPENA ;
+1 DO OPEN^%ZISH("TIUA"_TIUFILEN,TIUPATH,TIUANAME_TIUFILEN_".TXT","W")
+2 IF POP'=0
WRITE !,"Error opening TIU Addendum output file.",!
+3 QUIT
