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

TIU215F.m

Go to the documentation of this file.
  1. TIU215F ;VMP/ELR - 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. ;COMPARE CHECKSUMS BETWEEN TIU AND SURGERY TO TRY AND FIND RECORDS WHERE THE ADDENDUM WAS NOT FILED IN TIU
  1. ; DBIA 4502 TO ACCESS SURGERY FILE
  1. ; DBIA 5025 ACCESS ROUTINE SROANR
  1. ; DBIA 5024 ACCESS ROUTINE SRONRPT
  1. ENV ;DUMMY ENVIRONMENT CHECK TO GET ROUTINE LOADED FOR USE IN INSTALL QUESTIONS
  1. Q
  1. STRT ;
  1. Q
  1. W !!!
  1. W !,"1. ANALYZE POTENTIAL SURGERY/TIU PROBLEMS"
  1. W !,"2. VIEW SINGLE SURGERY CASE USING CASE #"
  1. W !,"3, SEND OUTPUT TO TEXT FILES"
  1. S DIR("A")="SELECT 1 OR 2 OR 3"
  1. S DIR(0)=("N^1:3")
  1. D ^DIR
  1. I $D(DIRUT) K DIRUT Q
  1. K DIR
  1. G EN:Y=1
  1. G ASK:Y=2
  1. D ^TIU215R G STRT
  1. Q
  1. EN NEW SRTN,TIUDA,TIUVAL,TIUCHKSU,SRVAL,SRCHKSUM,TIUDT,SRTNA,TIUEND
  1. NEW TIUA,TIUDAD,TIUDFN,TIUDONE,TIUNAM,TIUND,TIUX,TIUERR
  1. S U="^"
  1. K ^TMP("TIUSNIR",$J),^TMP("SRNIR",$J)
  1. S DIR("A")="Enter a date equal or prior to the date patch was installed"
  1. S DIR(0)="D^:DT:EX"
  1. D ^DIR
  1. K DIR
  1. I $D(DIRUT) K DIRUT G STRT
  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. EN1 ;
  1. NEW TIUCNT S TIUCNT=0
  1. D HD
  1. G EN2:$G(TIUDT)'>0
  1. S TIUDT=TIUDT-.0001
  1. F S TIUDT=$O(^SRF("AC",TIUDT)) Q:'$L(TIUDT) Q:TIUDT\1>TIUEND D
  1. . S TIUA=0 F S TIUA=$O(^SRF("AC",TIUDT,TIUA)) Q:TIUA'>0 D
  1. . . S TIUDONE="" D CHK,CHK1
  1. I $D(XPDQUES),$G(XPDQUES("POS1"))=1 D BULL
  1. EN2 I $D(XPDQUES),$G(XPDQUES("POS1"))'=1 D MSG H .5
  1. I $G(TIUERR)=1 D BULL1("It looks like you did not back out patch TIU*1.0*215")
  1. I $D(XPDQUES) Q
  1. G STRT
  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 SETLN("NIR")
  1. K @TIUVAL,@SRVAL
  1. Q
  1. CHK1 ;
  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("TIUSNIR",$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("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(""SRANE"","_$J_","_+SRTN_")"
  1. S SRCHKSUM=$$CHKSUM^XUSESIG1(SRVAL)
  1. I $G(TIUCHKSU)=$G(SRCHKSUM) Q
  1. D SETLN("ANES")
  1. K @TIUVAL,@SRVAL
  1. Q
  1. NAM NEW DFN
  1. Q:$G(TIUDONE)=1
  1. S TIUNAM=$P($G(^TIU(8925,TIUDA,0)),U,2)
  1. S DFN=TIUNAM D DEM^VADPT
  1. I $D(XPDQUES) S TIUNAM=$E(VADM(1))_VA("BID")
  1. E S TIUNAM=$E(VADM(1),1,20)
  1. S Y=$P($G(^TIU(8925,TIUDA,13)),U,1)
  1. D DD^%DT S TIUND=Y
  1. S TIUDONE=1
  1. Q
  1. ASK S DIR(0)="P^130"
  1. S DIR("A")="ENTER THE CASE NUMBER AS `NNNNNN"
  1. D ^DIR
  1. I $D(DIRUT) K DIRUT G STRT
  1. S SRTN=+Y
  1. D ^%ZIS G ASK:$G(POP)=1
  1. N TIUERR S TIUERR=""
  1. D SRHDR
  1. U IO
  1. W !,SRHDR
  1. W !,?4,"PRINTED BY TIU215F UTILITY***** NURSE INTRAOPERATIVE REPORT - CASE #"_SRTN
  1. ;D CSUM I $G(TIUERR)=1 W !!,"******It looks like you did not back out patch TIU*1.0*215*****",!
  1. RPT D RPT^SRONRPT(SRTN) S DFN=$P(^SRF(SRTN,0),"^")
  1. S SRI=0 F S SRI=$O(^TMP("SRNIR",$J,SRTN,SRI)) Q:'SRI D
  1. .W !,^TMP("SRNIR",$J,SRTN,SRI),!
  1. I $Y'=0 W @IOF
  1. G RPTX:$P($G(^SRF(SRTN,"TIU")),"^",4)'>0
  1. S TIUDA=$P($G(^SRF(SRTN,"TIU")),"^",4) G RPTX:$P($G(^TIU(8925,TIUDA,0)),U,5)=1
  1. W !,SRHDR
  1. W !,?3,"PRINTED BY TIU215F UTILITY***** ANESTHESIA REPORT - CASE #"_SRTN
  1. I $G(TIUERR)=1 W !!,"******It looks like you did not back out patch TIU*1.0*215*****",!
  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. RPTX D ^%ZISC
  1. K SRAGE,SRDIV,SRHDR,SRI,SRLOC,SRPRINT,SRSDATE,TIUERR,VADM,VA,POP,SREST,SRP,SRPOS,SRTN,VAINDT
  1. G ASK
  1. SRHDR 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. HD NEW HD1,HD2,HD3,HD4,HD5,TIUI,Y
  1. S HD1="DIFFERENCE IN CHECKSUMS BETWEEN SURGERY & TIU "
  1. S HD2="RUN DATE " D NOW^%DTC S Y=% D DD^%DT S HD2=HD2_Y K %
  1. S HD3="START DATE " S Y=TIUDT D DD^%DT S HD3=HD3_Y
  1. S HD4="END DATE " S Y=TIUEND D DD^%DT S HD4=HD4_Y
  1. S HD5="TYPE CASE #",$E(HD5,37)=" ",HD5=HD5_"TIU NOTE DATE",$E(HD5,57)=" ",HD5=HD5_"PATIENT "
  1. I '$D(XPDQUES) W !,HD1,!,HD2,!,HD3,!,HD4,!,HD5 Q
  1. F TIUI=HD1,HD2,HD3,HD4,HD5 S TIUCNT=TIUCNT+1,^TMP("TIU215F",$J,TIUCNT)=TIUI
  1. Q
  1. SETLN(A) ;
  1. NEW TIULN
  1. S TIUCNT=TIUCNT+1
  1. S TIULN=A,$E(TIULN,5)=" "
  1. S TIULN=TIULN_" "_SRTN
  1. S TIUDAD=0,TIUDAD=$O(^TIU(8925,"DAD",TIUDA,TIUDAD))
  1. I +TIUDAD>0 S TIULN=TIULN_" TIU REPORT HAS ADDENDUM"
  1. D NAM
  1. S $E(TIULN,37)=" ",TIULN=TIULN_TIUND,$E(TIULN,57)=" ",TIULN=TIULN_TIUNAM
  1. I '$D(XPDQUES) W !,TIULN Q
  1. S ^TMP("TIU215F",$J,TIUCNT)=TIULN
  1. Q
  1. INS ;ENTRY POINT FOR INSTALL
  1. S TIUDT=$G(XPDQUES("POS2"))
  1. S TIUEND=$G(XPDQUES("POS3"))
  1. K ^TMP("TIU215F",$J)
  1. ;D CSUM
  1. G EN1
  1. BULL ; Bulletin of analysis
  1. N XMSUB,XMTEXT,XMY,XMDUZ,DIFROM,XMZ,XMMG
  1. I $G(TIUCNT)'>5 S ^TMP("TIU215F",$J,6)="No discrepencies found in date range"
  1. S XMSUB="ANALYSIS OF POTENTIAL PROBLEMS CAUSED BY PATCH TIU*1.0*215 " K XMY
  1. S XMTEXT="^TMP(""TIU215F"",$J,"
  1. S XMY($S(DUZ:DUZ,1:.5))=""
  1. S XMDUZ=.5 D NOW^%DTC
  1. D ^XMD
  1. K ^TMP("TIU215F",$J),XMY,XMTEXT,XMSUB
  1. Q
  1. BULL1(A) ; Bulletin
  1. S TIUCNT=TIUCNT+1
  1. N XMSUB,XMTEXT,XMY,XMDUZ,DIFROM,XMZ,XMMG
  1. S XMSUB="ANALYSIS OF POTENTIAL PROBLEMS CAUSED BY PATCH TIU*1.0*215" K XMY
  1. S XMTEXT="^TMP(""TIU215F"",$J,"
  1. S ^TMP("TIU215F",$J,TIUCNT)=A
  1. S XMY($S(DUZ:DUZ,1:.5))=""
  1. S XMDUZ=.5 D NOW^%DTC
  1. D ^XMD
  1. K ^TMP("TIU215F",$J),XMY,XMTEXT,XMSUB
  1. Q
  1. POS2 I $G(XPDQUES("POS1"))'=1 K DIR Q
  1. Q
  1. POS3 I $G(XPDQUES("POS1"))'=1 K DIR Q
  1. S DIR(0)="D^"_$G(XPDQUES("POS2"))_":DT:EX"
  1. Q
  1. CSUM Q I $D(^%ZOSF("RSUM1")) N X,Y S TIUERR="",X="TIULP" X ^%ZOSF("RSUM1") I Y'="47310116" S TIUERR=1
  1. Q
  1. MSG NEW TIUMSG S TIUMSG="No analysis performed, you entered patch not loaded. "
  1. I +$O(^XPD(9.7,"B","TIU*1.0*215",0)) S TIUMSG=TIUMSG_"But it is in your install file"
  1. D BULL1(TIUMSG)
  1. Q