Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: TIU215R

TIU215R.m

Go to the documentation of this file. 
  1. 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
  1.  ; DBIA 4502 TO ACCESS SURGERY FILE
  1.  ; DBIA 5025 ACCESS ROUTINE SROANR
  1.  ; DBIA 5024 ACCESS ROUTINE SRONRP
  1. STRT ;
  1.  W !!
  1. 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
  1.  NEW TIUIO,SURIO,TIUCPF,TIUAIO,TIUANAME
  1.  S U="^",SURFILEN=1,TIUFILEN=1,TIUACNT=0
  1.  K ^TMP("TIUSNIR",$J),^TMP("SRNIR",$J)
  1.  S DIR("A")="Enter a begin date to start searching Surgery cases "
  1.  S DIR(0)="D^:DT:EX"
  1.  D ^DIR
  1.  I $D(DIRUT) K DIRUT Q
  1.  K DIR
  1.  S TIUDT=+Y
  1.  S DIR("A")="Enter date patch was backed out"
  1.  S DIR(0)="D^"_TIUDT_":DT:EX"
  1.  D ^DIR
  1.  K DIR
  1.  I $D(DIRUT) K DIRUT G STRT
  1.  S TIUEND=+Y
  1.  S DIR("A")="Enter the maximum number of cases per file"
  1.  S DIR(0)="N^5:50"
  1.  D ^DIR
  1.  K DIR
  1.  I $D(DIRUT) K DIRUT G STRT
  1.  S TIUCPF=Y
  1. PATH ;
  1.  K TIUFDEL
  1.  S DIR("A")="Enter the path of the output files"
  1.  S DIR(0)="F"
  1.  S DIR("?")=" "
  1.  S DIR("?",1)="Enter file path as USER$:[<DIRECTORY NAME>]"
  1.  D ^DIR
  1.  I $D(DIRUT) K DIRUT G STRT
  1.  S TIUPATH=Y
  1.  K DIR
  1.  S DIR("A")="Surgery output file (without file extension)"
  1.  S DIR(0)="F"
  1.  D ^DIR
  1.  K DIR
  1.  I $D(DIRUT) K DIRUT G PATH
  1.  S SURFNAME=Y
  1.  D OPENS I POP'=0 G PATH
  1.  S TIUFDEL(SURFNAME_SURFILEN_".TXT")=""
  1.  D CLOSE^%ZISH("SUR"_SURFILEN)
  1.  S DIR("A")="TIU output file (without file extension)"
  1.  S DIR(0)="F"
  1.  D ^DIR I $D(DIRUT) S TIUER=$$DEL^%ZISH(TIUPATH,$NA(TIUFDEL)) D ERR:'TIUER K DIR,DIRUT G PATH
  1.  S TIUFNAME=Y
  1.  K DIR
  1.  D OPENT I POP'=0 S TIUER=$$DEL^%ZISH(TIUPATH,$NA(TIUFDEL)) D ERR:'TIUER K DIR G PATH
  1.  S TIUFDEL(TIUFNAME_TIUFILEN_".TXT")=""
  1.  D CLOSE^%ZISH("TIU"_TIUFILEN)
  1.  S DIR("A")="TIU Addenda output file (without file extension)"
  1.  S DIR(0)="F"
  1.  D ^DIR I $D(DIRUT) S TIUER=$$DEL^%ZISH(TIUPATH,$NA(TIUFDEL)) D ERR:'TIUER K DIR,DIRUT G PATH
  1.  S TIUANAME=Y
  1.  K DIR
  1.  D OPENA I POP'=0 S TIUER=$$DEL^%ZISH(TIUPATH,$NA(TIUFDEL)) D ERR:'TIUER K DIR G PATH
  1.  S TIUADEL(TIUANAME_TIUFILEN_".TXT")=""
  1.  D CLOSE^%ZISH("TIUA"_TIUFILEN)
  1.  W !!!,"Processing...",!
  1.  S TIUIO=TIUPATH_TIUFNAME,SURIO=TIUPATH_SURFNAME,TIUAIO=TIUPATH_TIUANAME
  1.  K TIUFDEL
  1. EN1 ;
  1.  NEW TIUCNT,TIURECNT,SURRECNT,TIUCOUNT,SURDT,SURDONE S TIUCNT=0,TIURECNT=0,SURRECNT=0,TIUCOUNT=0
  1.  ; LOOP THROUGH SURGERY CASES WITHIN DATE RANGE
  1.  S (TIUDT,SURDT)=TIUDT-.0001
  1.  F  S SURDT=$O(^SRF("AC",SURDT)) Q:'$L(SURDT)  Q:SURDT\1>TIUEND  D
  1.  . S TIUA=0 F  S TIUA=$O(^SRF("AC",SURDT,TIUA)) Q:TIUA'>0  D
  1.  . . S SURDONE="" D CHK,CHK1
  1.  I TIUACNT=0 S TIUER=$$DEL^%ZISH(TIUPATH,$NA(TIUADEL))
  1. EN2 ; 
  1.  W !,"There were "_TIUCOUNT_" records found to be discrepant.",!
  1.  Q
  1.  ; BUILD TMP GLOBALS AND COMPARE NIR CASES
  1. CHK S SRTN=TIUA
  1.  S TIUDA=$P($G(^SRF(SRTN,"TIU")),"^",2)
  1.  Q:+TIUDA'>0
  1.  ;DONT EVALUATE UNDICTATED
  1.  Q:$P($G(^TIU(8925,TIUDA,0)),U,5)=1
  1.  S TIUDFN=$P($G(^TIU(8925,TIUDA,0)),U,2)
  1.  K ^TMP("TIUSNIR",$J),^TMP("SRNIR",$J)
  1.  D RPT^SRONRPT(SRTN)
  1.  ;STRIP OUT SUBFILE DATA
  1.  S TIUX=0
  1.  F  S TIUX=$O(^TIU(8925,+TIUDA,"TEXT",TIUX)) Q:TIUX=""  D
  1.  . S ^TMP("TIUSNIR",$J,TIUDA,TIUX)=$G(^TIU(8925,+TIUDA,"TEXT",TIUX,0))
  1.  S TIUVAL="^TMP(""TIUSNIR"","_$J_","_+TIUDA_")"
  1.  S TIUCHKSU=$$CHKSUM^XUSESIG1(TIUVAL)
  1.  S SRVAL="^TMP(""SRNIR"","_$J_","_+SRTN_")"
  1.  S SRCHKSUM=$$CHKSUM^XUSESIG1(SRVAL)
  1.  I $G(TIUCHKSU)=$G(SRCHKSUM) Q
  1.  D NRPT
  1.  S TIURECNT=TIURECNT+1,SURRECNT=SURRECNT+1,TIUCOUNT=TIUCOUNT+1
  1.  K @TIUVAL,@SRVAL
  1.  Q
  1. CHK1 ; COMPARE ANESTHESIA REPORTS
  1.  S TIUDA=$P($G(^SRF(SRTN,"TIU")),"^",4)
  1.  Q:+TIUDA'>0
  1.  ;DONT EVALUATE UNDICTATED
  1.  Q:$P($G(^TIU(8925,TIUDA,0)),U,5)=1
  1.  K ^TMP("TIUSRANE",$J),^TMP("SRANE",$J)
  1.  D RPT^SROANR(SRTN)
  1.  ;STRIP OUT SUBFILE DATA
  1.  S TIUX=0
  1.  F  S TIUX=$O(^TIU(8925,+TIUDA,"TEXT",TIUX)) Q:TIUX=""  D
  1.  . S ^TMP("TIUSRANE",$J,TIUDA,TIUX)=$G(^TIU(8925,+TIUDA,"TEXT",TIUX,0))
  1.  S TIUVAL="^TMP(""TIUSRANE"","_$J_","_+TIUDA_")"
  1.  S TIUCHKSU=$$CHKSUM^XUSESIG1(TIUVAL)
  1.  S SRVAL="^TMP(""SRANE"","_$J_","_+SRTN_")"
  1.  S SRCHKSUM=$$CHKSUM^XUSESIG1(SRVAL)
  1.  I $G(TIUCHKSU)=$G(SRCHKSUM) Q
  1.  D ARPT
  1.  S TIURECNT=TIURECNT+1,SURRECNT=SURRECNT+1,TIUCOUNT=TIUCOUNT+1
  1.  K @TIUVAL,@SRVAL
  1.  Q
  1. NRPT  D RPT^SRONRPT(SRTN) S DFN=$P(^SRF(SRTN,0),"^")
  1.  D SRHDR
  1.  D:SURRECNT=TIUCPF NEWSFILE
  1.  ;D CLOSE^%ZISH("TIU"_TIUFILEN)
  1.  D OPEN^%ZISH("SUR"_SURFILEN,TIUPATH,SURFNAME_SURFILEN_".TXT","A")
  1.  U SURIO_SURFILEN_".TXT"
  1.  W !!!!!!,SRHDR
  1.  W !,?4,"PRINTED BY TIU215R UTILITY***** NURSE INTRAOPERATIVE REPORT - CASE #"_SRTN
  1.  S SRI=0 F  S SRI=$O(^TMP("SRNIR",$J,SRTN,SRI)) Q:'SRI  D
  1.  .W !,^TMP("SRNIR",$J,SRTN,SRI),!
  1.  D SRHDR
  1.  D:TIURECNT=TIUCPF NEWTFILE
  1.  D CLOSE^%ZISH("SUR"_SURFILEN)
  1.  D OPEN^%ZISH("TIU"_TIUFILEN,TIUPATH,TIUFNAME_TIUFILEN_".TXT","A")
  1.  U TIUIO_TIUFILEN_".TXT"
  1.  I +TIUDA'>0 G NE
  1.  W !!!!!!,SRHDR
  1.  W !,?4,"PRINTED BY TIU215R UTILITY***** NURSE INTRAOPERATIVE REPORT - CASE #"_SRTN
  1.  S SRI=0 F  S SRI=$O(^TMP("TIUSNIR",$J,TIUDA,SRI)) Q:'SRI  D
  1.  .W !,^TMP("TIUSNIR",$J,TIUDA,SRI),!
  1.  S TIUDAD=$O(^TIU(8925,"DAD",TIUDA,0))
  1.  I +TIUDAD>0 D CLOSE^%ZISH("TIU"_TIUFILEN),ADDENDA
  1. NE D CLOSE^%ZISH("TIU"_TIUFILEN)
  1.  D KIL
  1.  Q
  1. ARPT ;
  1.  D SRHDR
  1.  D:SURRECNT=TIUCPF NEWSFILE
  1.  ;D CLOSE^%ZISH("TIU"_TIUFILEN)
  1.  D OPEN^%ZISH("SUR"_SURFILEN,TIUPATH,SURFNAME_SURFILEN_".TXT","A")
  1.  U SURIO_SURFILEN_".TXT"
  1.  W !,SRHDR
  1.  W !,?3,"PRINTED BY TIU215R UTILITY***** ANESTHESIA REPORT - CASE #"_SRTN
  1.  D RPT^SROANR(SRTN)
  1.  S DFN=$P(^SRF(SRTN,0),"^")
  1.  S SRI=0 F  S SRI=$O(^TMP("SRANE",$J,SRTN,SRI)) Q:'SRI  D
  1.  .W !,^TMP("SRANE",$J,SRTN,SRI),!
  1.  D SRHDR
  1.  D:TIURECNT=TIUCPF NEWTFILE
  1.  D CLOSE^%ZISH("SUR"_SURFILEN)
  1.  D OPEN^%ZISH("TIU"_TIUFILEN,TIUPATH,TIUFNAME_TIUFILEN_".TXT","A")
  1.  U TIUIO_TIUFILEN_".TXT"
  1.  I +TIUDA'>0 G AE
  1.  W !!!!!!,SRHDR
  1.  W !,?3,"PRINTED BY TIU215R UTILITY***** ANESTHESIA REPORT - CASE #"_SRTN
  1.  S SRI=0 F  S SRI=$O(^TMP("TIUSRANE",$J,TIUDA,SRI)) Q:'SRI  D
  1.  .W !,^TMP("TIUSRANE",$J,TIUDA,SRI),!
  1.  S TIUDAD=$O(^TIU(8925,"DAD",TIUDA,0))
  1.  I +TIUDAD>0 D CLOSE^%ZISH("TIU"_TIUFILEN),ADDENDA
  1. AE D CLOSE^%ZISH("TIU"_TIUFILEN)
  1.  D KIL
  1.  Q
  1. KIL K SRHDR,SRI,SRSDATE,VADM,VA,POP,VAINDT
  1.  Q
  1. ERR W !,"UNABLE TO CLEAN UP FILES ON ^ ABORT" Q
  1. SRHDR NEW DFN,Y
  1.  S DFN=$P(^SRF(SRTN,0),"^") D DEM^VADPT
  1.  S Y=$E($P(^SRF(SRTN,0),"^",9),1,7) D D^DIQ S SRSDATE=Y
  1.  S SRHDR=" "_VADM(1)_" ("_VA("PID")_")   Case #"_SRTN_" - "_SRSDATE
  1.  Q
  1. ADDENDA ;
  1.  N TIUI,TIUDAD S TIUI=0,TIUDAD=0,TIUACNT=1
  1.  D OPEN^%ZISH("TIUA"_TIUFILEN,TIUPATH,TIUANAME_TIUFILEN_".TXT","A")
  1.  U TIUAIO_TIUFILEN_".TXT"
  1.  W !!!!,"**************************************************************************",!,SRHDR
  1.  W !,?4,"PRINTED BY TIU215F UTILITY***** TIU ADDENDA - CASE #"_SRTN,!,"**************************************************************************",!
  1.   ; Loop through all addenda for that note
  1.  F  S TIUDAD=$O(^TIU(8925,"DAD",TIUDA,TIUDAD)) Q:TIUDAD'>0  D
  1.  . W !!,?2,"ADDENDUM #"_TIUDAD,!,?2,"-----------------------------------------" S TIUI=0
  1.  . ; Loop through entire addendum
  1.  . F  S TIUI=$O(^TIU(8925,TIUDAD,"TEXT",TIUI)) Q:TIUI'>0  D
  1.  . . W !,$G(^TIU(8925,TIUDAD,"TEXT",TIUI,0))
  1.  D CLOSE^%ZISH("TIUA"_TIUFILEN)
  1.  Q
  1. NEWSFILE ;
  1.  D CLOSE^%ZISH("SUR"_SURFILEN) S SURFILEN=SURFILEN+1,SURRECNT=0
  1.  D OPEN^%ZISH("SUR"_SURFILEN,TIUPATH,SURFNAME_SURFILEN_".TXT","W")
  1.  Q
  1. NEWTFILE ;
  1.  D CLOSE^%ZISH("TIU"_TIUFILEN) S TIUFILEN=TIUFILEN+1,TIURECNT=0
  1.  D OPEN^%ZISH("TIU"_TIUFILEN,TIUPATH,TIUFNAME_TIUFILEN_".TXT","W")
  1.  Q
  1. OPENS ;
  1.  D OPEN^%ZISH("SUR"_SURFILEN,TIUPATH,SURFNAME_SURFILEN_".TXT","W")
  1.  I POP'=0 W !,"Error opening Surgery output file.",!
  1.  Q
  1. OPENT ;
  1.  D OPEN^%ZISH("TIU"_TIUFILEN,TIUPATH,TIUFNAME_TIUFILEN_".TXT","W")
  1.  I POP'=0 W !,"Error opening TIU output file.",!
  1.  Q
  1. OPENA ;
  1.  D OPEN^%ZISH("TIUA"_TIUFILEN,TIUPATH,TIUANAME_TIUFILEN_".TXT","W")
  1.  I POP'=0 W !,"Error opening TIU Addendum output file.",!
  1.  Q