RABTCH3 ;HISC/GJC-Delete Batch Reports ;8/2/94 10:08
;;5.0;Radiology/Nuclear Medicine;;Mar 16, 1998
; The user accessing this option will only be able to delete
; Report Batches he/she has created through the RA BTCHNEW option.
; For the option: RA BTCHDEL
;
; ***** Variable List *****
; ^TMP($J,"RA BTCHDEL",xternal fmat of .01,ien of record)=""
;
DEL ; Does this user have data to delete?
Q:'$D(^RABTCH(74.2,"C",DUZ))
N A,B,C,I,RADIC,RAHEAD,RALINE,RAOUT,RAPAGE,RATDAY
S (RAOUT,RAPAGE)=0,Y=DT X ^DD("DD") S RATDAY=Y
K ^TMP($J,"RA BTCHDEL"),^TMP($J,"RA BTCHDEL SEL")
S RADIC="^RABTCH(74.2,",RADIC(0)="QEAMZ",RAUTIL="RA BTCHDEL"
S RADIC("A")="Select Batch Name: ",RADIC("S")="I +$P(^(0),U,3)=DUZ"
S RADIC("W")="D DICW^RABTCH3"
D EN1^RASELCT(.RADIC,RAUTIL)
I $G(RAQUIT)!('$D(^TMP($J,"RA BTCHDEL"))) D KILL Q
S $P(RALINE,"*",(IOM+1))=""
S RAHEAD="<<< Report Batches To Be Deleted >>>"
D HDR
S A="" F S A=$O(^TMP($J,"RA BTCHDEL",A)) Q:A']"" D
. S Y=0 F S Y=$O(^TMP($J,"RA BTCHDEL",A,Y)) Q:Y'>0 D
.. S C=+$G(C)+1
.. W !,C_"]",?5,A D DICW
.. Q
. I $Y>(IOSL-4) D
.. S RAOUT=$$EOS^RAUTL5()
.. D:'RAOUT HDR
.. Q
. Q
W ! K DIR S DIR(0)="YA"
S DIR("A")="Do you wish to delete all the above Report Batches? "
S DIR("?",1)="Enter 'Y' to delete all the above report batches or 'N' to"
S DIR("?")="bypass the deletion of the report batches." D ^DIR K DIR
I '+Y D KILL Q
W !!?5,"Beginning the interactive deletion process."
W !?5,"<Deleting>"
K DA,DIK S A="",DIK="^RABTCH(74.2,"
F S A=$O(^TMP($J,"RA BTCHDEL",A)) Q:A']"" D
. S B=0 F S B=$O(^TMP($J,"RA BTCHDEL",A,B)) Q:B'>0 D
.. S DA=B W:DA>0 "." D:DA>0 ^DIK
.. Q
. Q
W !?5,"Deletion process has successfully completed."
KILL ; Kill and quit
K %,DA,DDH,DIC,DIK,DIR,DIROUT,DIRUT,DTOUT,DUOUT,RAQUIT,RAUTIL,X,Y,POP
Q
DICW ; Display data
N RAY S RAY=+Y
N RA,RABTCHC,RABTCHP,Y
S RA=$G(^RABTCH(74.2,RAY,0))
S RABTCHC=$P(RA,U,2),RABTCHP=$P(RA,U,4)
S Y=RABTCHC X:Y]"" ^DD("DD") S RABTCHC=Y
S Y=RABTCHP X:Y]"" ^DD("DD") S RABTCHP=Y
W ?40,"<Batch Created>: ",RABTCHC,!?40,"<Batch Printed>: ",RABTCHP
Q
HDR ; Header
S RAPAGE=RAPAGE+1
W @IOF,!?$S(IOM=132:104,1:63),"Date: ",RATDAY
W !?$S(IOM=132:104,1:63),"Page: ",RAPAGE
W !?(IOM-$L(RAHEAD)\2),RAHEAD,!,RALINE
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRABTCH3 2333 printed Apr 09, 2024@21:37:07 Page 2
RABTCH3 ;HISC/GJC-Delete Batch Reports ;8/2/94 10:08
+1 ;;5.0;Radiology/Nuclear Medicine;;Mar 16, 1998
+2 ; The user accessing this option will only be able to delete
+3 ; Report Batches he/she has created through the RA BTCHNEW option.
+4 ; For the option: RA BTCHDEL
+5 ;
+6 ; ***** Variable List *****
+7 ; ^TMP($J,"RA BTCHDEL",xternal fmat of .01,ien of record)=""
+8 ;
DEL ; Does this user have data to delete?
+1 if '$DATA(^RABTCH(74.2,"C",DUZ))
QUIT
+2 NEW A,B,C,I,RADIC,RAHEAD,RALINE,RAOUT,RAPAGE,RATDAY
+3 SET (RAOUT,RAPAGE)=0
SET Y=DT
XECUTE ^DD("DD")
SET RATDAY=Y
+4 KILL ^TMP($JOB,"RA BTCHDEL"),^TMP($JOB,"RA BTCHDEL SEL")
+5 SET RADIC="^RABTCH(74.2,"
SET RADIC(0)="QEAMZ"
SET RAUTIL="RA BTCHDEL"
+6 SET RADIC("A")="Select Batch Name: "
SET RADIC("S")="I +$P(^(0),U,3)=DUZ"
+7 SET RADIC("W")="D DICW^RABTCH3"
+8 DO EN1^RASELCT(.RADIC,RAUTIL)
+9 IF $GET(RAQUIT)!('$DATA(^TMP($JOB,"RA BTCHDEL")))
DO KILL
QUIT
+10 SET $PIECE(RALINE,"*",(IOM+1))=""
+11 SET RAHEAD="<<< Report Batches To Be Deleted >>>"
+12 DO HDR
+13 SET A=""
FOR
SET A=$ORDER(^TMP($JOB,"RA BTCHDEL",A))
if A']""
QUIT
Begin DoDot:1
+14 SET Y=0
FOR
SET Y=$ORDER(^TMP($JOB,"RA BTCHDEL",A,Y))
if Y'>0
QUIT
Begin DoDot:2
+15 SET C=+$GET(C)+1
+16 WRITE !,C_"]",?5,A
DO DICW
+17 QUIT
End DoDot:2
+18 IF $Y>(IOSL-4)
Begin DoDot:2
+19 SET RAOUT=$$EOS^RAUTL5()
+20 if 'RAOUT
DO HDR
+21 QUIT
End DoDot:2
+22 QUIT
End DoDot:1
+23 WRITE !
KILL DIR
SET DIR(0)="YA"
+24 SET DIR("A")="Do you wish to delete all the above Report Batches? "
+25 SET DIR("?",1)="Enter 'Y' to delete all the above report batches or 'N' to"
+26 SET DIR("?")="bypass the deletion of the report batches."
DO ^DIR
KILL DIR
+27 IF '+Y
DO KILL
QUIT
+28 WRITE !!?5,"Beginning the interactive deletion process."
+29 WRITE !?5,"<Deleting>"
+30 KILL DA,DIK
SET A=""
SET DIK="^RABTCH(74.2,"
+31 FOR
SET A=$ORDER(^TMP($JOB,"RA BTCHDEL",A))
if A']""
QUIT
Begin DoDot:1
+32 SET B=0
FOR
SET B=$ORDER(^TMP($JOB,"RA BTCHDEL",A,B))
if B'>0
QUIT
Begin DoDot:2
+33 SET DA=B
if DA>0
WRITE "."
if DA>0
DO ^DIK
+34 QUIT
End DoDot:2
+35 QUIT
End DoDot:1
+36 WRITE !?5,"Deletion process has successfully completed."
KILL ; Kill and quit
+1 KILL %,DA,DDH,DIC,DIK,DIR,DIROUT,DIRUT,DTOUT,DUOUT,RAQUIT,RAUTIL,X,Y,POP
+2 QUIT
DICW ; Display data
+1 NEW RAY
SET RAY=+Y
+2 NEW RA,RABTCHC,RABTCHP,Y
+3 SET RA=$GET(^RABTCH(74.2,RAY,0))
+4 SET RABTCHC=$PIECE(RA,U,2)
SET RABTCHP=$PIECE(RA,U,4)
+5 SET Y=RABTCHC
if Y]""
XECUTE ^DD("DD")
SET RABTCHC=Y
+6 SET Y=RABTCHP
if Y]""
XECUTE ^DD("DD")
SET RABTCHP=Y
+7 WRITE ?40,"<Batch Created>: ",RABTCHC,!?40,"<Batch Printed>: ",RABTCHP
+8 QUIT
HDR ; Header
+1 SET RAPAGE=RAPAGE+1
+2 WRITE @IOF,!?$SELECT(IOM=132:104,1:63),"Date: ",RATDAY
+3 WRITE !?$SELECT(IOM=132:104,1:63),"Page: ",RAPAGE
+4 WRITE !?(IOM-$LENGTH(RAHEAD)\2),RAHEAD,!,RALINE
+5 QUIT
