source: WorldVistAEHR/trunk/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RABTCH3.m@ 1800

Last change on this file since 1800 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.2 KB
RevLine 
[613]1RABTCH3 ;HISC/GJC-Delete Batch Reports ;8/2/94 10:08
2 ;;5.0;Radiology/Nuclear Medicine;;Mar 16, 1998
3 ; The user accessing this option will only be able to delete
4 ; Report Batches he/she has created through the RA BTCHNEW option.
5 ; For the option: RA BTCHDEL
6 ;
7 ; ***** Variable List *****
8 ; ^TMP($J,"RA BTCHDEL",xternal fmat of .01,ien of record)=""
9 ;
10DEL ; Does this user have data to delete?
11 Q:'$D(^RABTCH(74.2,"C",DUZ))
12 N A,B,C,I,RADIC,RAHEAD,RALINE,RAOUT,RAPAGE,RATDAY
13 S (RAOUT,RAPAGE)=0,Y=DT X ^DD("DD") S RATDAY=Y
14 K ^TMP($J,"RA BTCHDEL"),^TMP($J,"RA BTCHDEL SEL")
15 S RADIC="^RABTCH(74.2,",RADIC(0)="QEAMZ",RAUTIL="RA BTCHDEL"
16 S RADIC("A")="Select Batch Name: ",RADIC("S")="I +$P(^(0),U,3)=DUZ"
17 S RADIC("W")="D DICW^RABTCH3"
18 D EN1^RASELCT(.RADIC,RAUTIL)
19 I $G(RAQUIT)!('$D(^TMP($J,"RA BTCHDEL"))) D KILL Q
20 S $P(RALINE,"*",(IOM+1))=""
21 S RAHEAD="<<< Report Batches To Be Deleted >>>"
22 D HDR
23 S A="" F S A=$O(^TMP($J,"RA BTCHDEL",A)) Q:A']"" D
24 . S Y=0 F S Y=$O(^TMP($J,"RA BTCHDEL",A,Y)) Q:Y'>0 D
25 .. S C=+$G(C)+1
26 .. W !,C_"]",?5,A D DICW
27 .. Q
28 . I $Y>(IOSL-4) D
29 .. S RAOUT=$$EOS^RAUTL5()
30 .. D:'RAOUT HDR
31 .. Q
32 . Q
33 W ! K DIR S DIR(0)="YA"
34 S DIR("A")="Do you wish to delete all the above Report Batches? "
35 S DIR("?",1)="Enter 'Y' to delete all the above report batches or 'N' to"
36 S DIR("?")="bypass the deletion of the report batches." D ^DIR K DIR
37 I '+Y D KILL Q
38 W !!?5,"Beginning the interactive deletion process."
39 W !?5,"<Deleting>"
40 K DA,DIK S A="",DIK="^RABTCH(74.2,"
41 F S A=$O(^TMP($J,"RA BTCHDEL",A)) Q:A']"" D
42 . S B=0 F S B=$O(^TMP($J,"RA BTCHDEL",A,B)) Q:B'>0 D
43 .. S DA=B W:DA>0 "." D:DA>0 ^DIK
44 .. Q
45 . Q
46 W !?5,"Deletion process has successfully completed."
47KILL ; Kill and quit
48 K %,DA,DDH,DIC,DIK,DIR,DIROUT,DIRUT,DTOUT,DUOUT,RAQUIT,RAUTIL,X,Y,POP
49 Q
50DICW ; Display data
51 N RAY S RAY=+Y
52 N RA,RABTCHC,RABTCHP,Y
53 S RA=$G(^RABTCH(74.2,RAY,0))
54 S RABTCHC=$P(RA,U,2),RABTCHP=$P(RA,U,4)
55 S Y=RABTCHC X:Y]"" ^DD("DD") S RABTCHC=Y
56 S Y=RABTCHP X:Y]"" ^DD("DD") S RABTCHP=Y
57 W ?40,"<Batch Created>: ",RABTCHC,!?40,"<Batch Printed>: ",RABTCHP
58 Q
59HDR ; Header
60 S RAPAGE=RAPAGE+1
61 W @IOF,!?$S(IOM=132:104,1:63),"Date: ",RATDAY
62 W !?$S(IOM=132:104,1:63),"Page: ",RAPAGE
63 W !?(IOM-$L(RAHEAD)\2),RAHEAD,!,RALINE
64 Q
Note: See TracBrowser for help on using the repository browser.