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