| [613] | 1 | RABTCH2 ;HISC/GJC-Batch Report Option, delete by date ;2/6/97 09:34
|
|---|
| 2 | ;;5.0;Radiology/Nuclear Medicine;;Mar 16, 1998
|
|---|
| 3 | DELDT ; Delete a batch within a specified date range.
|
|---|
| 4 | ;*** Variable List ***
|
|---|
| 5 | ; ^TMP($J,"RA BTCHDEL DT",ien)--> ien's of the records to be deleted
|
|---|
| 6 | ;
|
|---|
| 7 | N DIROUT,DIRUT,DTOUT,DUOUT,RA,RADUZ,RAUPRT,RAXIT,X,Y
|
|---|
| 8 | S RADUZ=+$G(DUZ)
|
|---|
| 9 | I '$D(^XUSEC("RA MGR",RADUZ)) D Q
|
|---|
| 10 | . W !?5,"This option can only be used by those Radiology/Nuclear"
|
|---|
| 11 | . W " Medicine users that"
|
|---|
| 12 | . W !?5,"have access to the Radiology/Nuclear Medicine Manager's"
|
|---|
| 13 | . W " (RA MGR) key.",$C(7)
|
|---|
| 14 | . Q
|
|---|
| 15 | S (RA("%"),RA("DT"),RAUPRT)=0
|
|---|
| 16 | F D Q:RA("%")!(RAUPRT<0)
|
|---|
| 17 | . K ^TMP($J,"RA BTCHDEL DT"),RA("CNT") S RAXIT=0
|
|---|
| 18 | . K %DT S %DT="PEA",%DT(0)="-NOW"
|
|---|
| 19 | . S %DT("A")="Purge report batches printed before: "
|
|---|
| 20 | . S Y=$S('$D(DT):($$NOW^XLFDT()\1),1:DT) X ^DD("DD")
|
|---|
| 21 | . S %DT("B")=Y
|
|---|
| 22 | . W !!?5,"All batches up to the date you enter will be purged"
|
|---|
| 23 | . W !?5,"from the Report Batches file #74.2.",$C(7),!
|
|---|
| 24 | . D ^%DT K %DT
|
|---|
| 25 | . S:Y=-1 RA("%")=1,RA("DT")=Y
|
|---|
| 26 | . Q:RA("%") S RA("DTI")=Y_".9999"
|
|---|
| 27 | . X ^DD("DD") S RA("DTX")=Y
|
|---|
| 28 | . W ! S RAUPRT=$$YN(RA("DTX")) Q:RAUPRT<0
|
|---|
| 29 | . D SETMP
|
|---|
| 30 | . I '+$G(RA("CNT")) D Q
|
|---|
| 31 | .. W !!?5,"No "_$S(RAUPRT=1:"unprinted or ",1:"")_"printed batches exist before: ",RA("DTX"),"!"
|
|---|
| 32 | .. Q
|
|---|
| 33 | . D DISPLAY Q:RAXIT
|
|---|
| 34 | . W !!?5,"'",RA("DTX"),"', are you sure?",!
|
|---|
| 35 | . K DIR S DIR(0)="Y"
|
|---|
| 36 | . S DIR("?",1)="Enter 'Y' if this date is acceptable,"
|
|---|
| 37 | . S DIR("?")="or 'N' if you wish to select another date."
|
|---|
| 38 | . D ^DIR K DIR
|
|---|
| 39 | . S:$D(DIRUT) RA("DT")=-1
|
|---|
| 40 | . S:$D(DIRUT)!(+Y) RA("%")=1
|
|---|
| 41 | . Q
|
|---|
| 42 | I RA("DT")=-1!(RAUPRT<0) D KILL1 Q
|
|---|
| 43 | W !!?5,"There"_$S(+$G(RA("CNT"))>1:" are ",1:" is ")
|
|---|
| 44 | W +$G(RA("CNT"))," batch"
|
|---|
| 45 | W $S(+$G(RA("CNT"))>1:"es ",1:" ")
|
|---|
| 46 | W "selected to be deleted."
|
|---|
| 47 | W !?5,"Do you wish to task this job off to be completed"
|
|---|
| 48 | W !?5,"at a later time?",!
|
|---|
| 49 | K DIR S DIR(0)="Y"
|
|---|
| 50 | S DIR("?",1)="Enter 'Y' to task off the job and delete these batches at"
|
|---|
| 51 | S DIR("?")="a later date, or 'N' to delete these batches immediately."
|
|---|
| 52 | D ^DIR K DIR
|
|---|
| 53 | I $D(DIRUT) D KILL1 Q
|
|---|
| 54 | I +Y D
|
|---|
| 55 | . S ZTRTN="DEL^RABTCH2",ZTIO=""
|
|---|
| 56 | . S ZTDESC="Rad/Nuc Med Delete entries in the Report Batches (74.2) file up to "
|
|---|
| 57 | . S ZTDESC=ZTDESC_RA("DTX")
|
|---|
| 58 | . S ZTSAVE("^TMP($J,""RA BTCHDEL DT"",")=""
|
|---|
| 59 | . D ^%ZTLOAD
|
|---|
| 60 | . Q
|
|---|
| 61 | E D
|
|---|
| 62 | . W !?5,$C(7),"Beginning the interactive deletion process.",!
|
|---|
| 63 | . D DEL
|
|---|
| 64 | . W !?5,"The deletion process has successfully completed!"
|
|---|
| 65 | . Q
|
|---|
| 66 | KILL ; Kill and quit
|
|---|
| 67 | K ZTIO,ZTDESC,ZTRTN,ZTSAVE,ZTSK
|
|---|
| 68 | KILL1 K ^TMP($J,"RA BTCHDEL DT")
|
|---|
| 69 | K DDH,I,POP
|
|---|
| 70 | Q
|
|---|
| 71 | DEL ; $O through the ^TMP global to delete entries in 74.2!
|
|---|
| 72 | N DA,DIC,DIK S DIK="^RABTCH(74.2,",DA=0
|
|---|
| 73 | F S DA=$O(^TMP($J,"RA BTCHDEL DT",DA)) Q:DA'>0 D ^DIK
|
|---|
| 74 | Q
|
|---|
| 75 | DISPLAY ; Display selected Report Batches data
|
|---|
| 76 | N I,RA,RABTCH,RADTC,RADTP,RATXT,RAUSER S RA=0
|
|---|
| 77 | S RATXT="W !!?5,""The following Report Batches have been selected to be purged:"",!"
|
|---|
| 78 | W:$Y @IOF X RATXT
|
|---|
| 79 | F S RA=$O(^TMP($J,"RA BTCHDEL DT",RA)) Q:RA'>0 D Q:RAXIT
|
|---|
| 80 | . S RA(0)=$G(^RABTCH(74.2,RA,0)) Q:RA(0)']""
|
|---|
| 81 | . F I=1:1:4 S RA(I)=$P(RA(0),"^",I)
|
|---|
| 82 | . S RADTC=$$XTERNAL^RAUTL5(RA(2),$P($G(^DD(74.2,2,0)),"^",2))
|
|---|
| 83 | . S RAUSER=$$XTERNAL^RAUTL5(RA(3),$P($G(^DD(74.2,3,0)),"^",2))
|
|---|
| 84 | . S RADTP=$$XTERNAL^RAUTL5(RA(4),$P($G(^DD(74.2,4,0)),"^",2))
|
|---|
| 85 | . I $Y>(IOSL-4) S RAXIT=$$EOS^RAUTL5() Q:RAXIT W @IOF X RATXT
|
|---|
| 86 | . W !?3,"Batch: ",$P(RA(0),"^")
|
|---|
| 87 | . W ?39,"Date Created: ",$S(RADTC]"":RADTC,1:"Unknown")
|
|---|
| 88 | . W !?3,"User: ",$S(RAUSER]"":RAUSER,1:"Unknown")
|
|---|
| 89 | . W ?39,"Date Printed: ",$S(RADTP]"":RADTP,1:""),!
|
|---|
| 90 | . Q
|
|---|
| 91 | Q
|
|---|
| 92 | SETMP ; Set ^TMP($J,"RA BTCHDEL DT"). If only printed batches are selected,
|
|---|
| 93 | ; (RAUPRT=0) then just hit the 'E' xref. If both printed and unprinted
|
|---|
| 94 | ; batches are selected (RAUPRT=1) hit the Date/Time Batch Created 'F'
|
|---|
| 95 | ; xref.
|
|---|
| 96 | N RAXREF S RAXREF=$S(RAUPRT:"F",1:"E") S RA=0
|
|---|
| 97 | F S RA=$O(^RABTCH(74.2,RAXREF,RA)) Q:RA'>0!(RA'<RA("DTI")) D
|
|---|
| 98 | . S RA(1)=0
|
|---|
| 99 | . F S RA(1)=$O(^RABTCH(74.2,RAXREF,RA,RA(1))) Q:RA(1)'>0 D
|
|---|
| 100 | .. S RA("CNT")=+$G(RA("CNT"))+1
|
|---|
| 101 | .. S ^TMP($J,"RA BTCHDEL DT",RA(1))=""
|
|---|
| 102 | .. Q
|
|---|
| 103 | . Q
|
|---|
| 104 | Q
|
|---|
| 105 | YN(RADT) ; Yes/No prompt asking the user if unprinted batches are to be
|
|---|
| 106 | ; included as criteria for our batch deletion.
|
|---|
| 107 | ; Returns: 1 if yes, 0 if no, -1 if '^' or timeout
|
|---|
| 108 | N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y S DIR(0)="Y",DIR("B")="No"
|
|---|
| 109 | S DIR("A")="Want to include unprinted batches created before "_RADT
|
|---|
| 110 | S DIR("?",1)="Enter 'Yes' to delete printed and unprinted batches prior to "_RADT_"."
|
|---|
| 111 | S DIR("?")="Enter 'No' to delete only printed batches prior to "_RADT_"."
|
|---|
| 112 | D ^DIR S:$D(DIRUT) Y=-1
|
|---|
| 113 | Q Y
|
|---|
