- 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 Jan 18, 2025@03:39:39 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