RABTCH ;HISC/CAH,FPT AISC/MJK,RMO-Batch Report Menu ;3/1/96 13:18
;;5.0;Radiology/Nuclear Medicine;**47**;Mar 16, 1998;Build 21
1 ;;Select a Batch
W ! K RABTCH S DIC("S")="I $P(^(0),U,3)=DUZ,'$P(^(0),U,4)",DIC("DR")="2///NOW;3////"_DUZ,DIC("A")="Select Batch: ",DIC="^RABTCH(74.2,",DIC(0)="AEZLQ",DLAYGO=74.2
D ^DIC G Q1:Y<0 S RABTCH=+Y,RABTCHN=$P(Y,"^",2)
Q1 K %,%DT,C,D0,DA,DDH,DI,DIC,DIE,DLAYGO,DQ,DR,I,POP,X,Y Q
;
2 ;;List Batch Entries
F RAPEAT=0:0 W ! Q:$G(RAX)["^" S DIC("A")="Select Batch: ",DIC="^RABTCH(74.2,",DIC(0)="AEZMQ" D ^DIC K DIC Q:Y<1 S RABTCH=+Y,ZTRTN="START2^RABTCH",ZTSAVE("RABTCH")="" W ! D ZIS^RAUTL I 'RAPOP D START2
K RAPEAT,RAPOP,RAX D Q2
Q
START2 ; start report processing
U IO S Y(0)=$G(^RABTCH(74.2,RABTCH,0)),RAPGE=0,RAX=""
N RA1 D HDR2
F I=0:0 S I=$O(^RABTCH(74.2,RABTCH,"R",I)) Q:I'>0!(RAX["^") I $D(^(I,0)) S RARPT=^(0),RAFL=$S($P(RARPT,"^",2)="Y":"*",1:""),RARPT=+RARPT I $D(^RARPT(RARPT,0)) S RA0=^(0),RA1=$O(^(1,"B",0)) D
.I $Y>(IOSL-4) D:$E(IOST)="C" CRCHK^RAORD6 D:$D(ZTQUEUED) STOPCHK^RAUTL9 S:$G(ZTSTOP)=1 RAX="^" Q:RAX["^" D HDR2
.S RACN=$P(RA0,"^",4),RADTI=9999999.9999-$P(RA0,"^",3),RADFN=+$P(RA0,"^",2)
.I $L($P(RA0,U,1))>12 S RACNI=$O(^RADPT("ADC1",$P(RA0,U,1),RADFN,RADTI,0))
.I $L($P(RA0,U,1))'>12 S RACNI=$O(^RADPT("ADC",$P(RA0,U,1),RADFN,RADTI,0))
.N RASSAN,RACNDSP S RASSAN=$$SSANVAL^RAHLRU1(RADFN,RADTI,RACNI)
.S RACNDSP=$S((RASSAN'=""):RASSAN,1:RACN)
.I $$USESSAN^RAHLRU1() W !?1,RAFL,?2,RACNDSP W:RA1]"" "+" S Y=$P($P(RA0,"^",3),".") D D^RAUTL W ?22,Y,?35,$S($D(^DPT(RADFN,0)):$E($P(^(0),"^"),1,29),1:"Unknown")
.I '$$USESSAN^RAHLRU1() W !?2,RAFL,?3,$J(RACN,4) W:RA1]"" " +" S Y=$P($P(RA0,"^",3),".") D D^RAUTL W ?15,Y,?30,$S($D(^DPT(RADFN,0)):$E($P(^(0),"^"),1,29),1:"Unknown")
.S Z="" I $D(^RADPT(RADFN,"DT",RADTI,"P","B",RACN)),$O(^(RACN,0))>0,$D(^RADPT(RADFN,"DT",RADTI,"P",$O(^(0)),0)) S Z=^(0)
.W ?60,$E($S($D(^VA(200,+$P(Z,"^",12),0)):$P(^(0),"^"),$D(^VA(200,+$P(Z,"^",15),0)):$P(^(0),"^"),1:"Unknown"),1,19)
Q2 K %,DIC,I,RA0,RABTCH,RACN,RADFN,RADTI,RAFL,RAPGE,RARPT,X,Y,Z,ZTQUEUED,ZTSTOP
K C,DDH,I,POP,DISYS
D CLOSE^RAUTL
Q
;
HDR2 ; report header
S RAPGE=RAPGE+1
W:$Y>0 @IOF
W !,"Batch: ",$P(Y(0),"^"),?30,"Date Created: " S Y=$P(Y(0),"^",2) D D^RAUTL W Y,?65,$S($D(^VA(200,+$P(Y(0),"^",3),0)):$E($P(^(0),"^"),1,14),1:"")
S Y=$P(Y(0),"^",4) D D^RAUTL:Y]"" W !?30,"Last Printed: ",Y,!!,"* indicates the report has been printed from batch",!
W $$REPEAT^XLFSTR("=",79)
I $$USESSAN^RAHLRU1() W !!?1,"Case No.",?22,"Exam Date",?35,"Patient",?60,"Interpreting Phys."
I $$USESSAN^RAHLRU1() W !?1,"----------------",?22,"-----------",?35,"--------------------",?60,"------------------"
I '$$USESSAN^RAHLRU1() W !!?1,"Case No.",?15,"Exam Date",?30,"Patient",?60,"Interpreting Phys."
I '$$USESSAN^RAHLRU1() W !?1,"--------",?15,"---------",?30,"-------",?60,"------------------"
Q
3 ;;Print a Batch
;SET^RAPSET1 is called so that RAMLC is defined and the default print
;device for report printing can be determined
D SET^RAPSET1 I $D(XQUIT) K XQUIT Q
W ! S DIC("A")="Select Batch: ",DIC="^RABTCH(74.2,",DIC(0)="AEZMQ" D ^DIC K DIC G Q3:Y<0 S RABTCH=+Y
W !!,"Batch: ",$P(Y(0),"^"),?30,"Date Created: " S Y=$P(Y(0),"^",2) D D^RAUTL W Y,?65,$S($D(^VA(200,+$P(Y(0),"^",3),0)):$E($P(^(0),"^"),1,14),1:"")
S Y=$P(Y(0),"^",4) D D^RAUTL:Y]"" W !?30,"Last Printed: ",Y
ASKPRT R !!,"Are you sure? No// ",X:DTIME S:'$T!(X="")!(X["^") X="N" G Q3:"Nn"[$E(X) I "Yy"'[$E(X) W:X'["?" *7 W !!?3,"Enter 'YES' to print this batch, or 'NO' not to." G ASKPRT
BTCH S ION=$P(RAMLC,"^",10),IOP=$S(ION]"":"Q;"_ION,1:"Q")
S DIE="^RABTCH(74.2,",DA=RABTCH,DR="4///^S X=""NOW""" D ^DIE
S ZTRTN="START^RABTCH",ZTSAVE("RABTCH")=""
W ! D ZIS^RAUTL G Q3:RAPOP
START U IO S U="^",RABT=RABTCH
S X="T",%DT="" D ^%DT S DT=Y
F RABTI=0:0 S RABTI=$O(^RABTCH(74.2,RABT,"R",RABTI)) Q:RABTI'>0 I $D(^(RABTI,0)) S RABTCH=RABT,RARPT=+^(0),^(0)=RARPT_"^Y" D PRT^RARTR
Q3 K C,D0,DA,DIE,DR,J,K,RABT,RABTI,RADTI,RACN,RADTE,RADFN,RARPT,RABTCH,W,RAPOP
K %W,%X,%Y1,D,DI,DIC,DQ,X,Y
K DDH,DISYS,I,POP
W ! D CLOSE^RAUTL Q
;
4 ;;Remove/Add a Report from a Batch
W ! S DIC("S")="I $P(^(0),U,3)=DUZ",DIC("A")="Select Batch: ",DIC="^RABTCH(74.2,",DIC(0)="AEZMQ" D ^DIC K DIC G Q4:Y<0 S DA=+Y
S DIE="^RABTCH(74.2,",DR="25",DR(2,74.21)=".01" D ^DIE
Q4 K %,%Y,C,D0,DA,DIE,DR,J,K,RABT,RABTI,RADTI,RACN,RADTE,RADFN,RARPT,RABTCH,W
K D,D1,DDH,DI,DIC,DIZ,DLAYGO,DQ,I,X
K DDC,DST,DISYS,POP
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRABTCH 4504 printed Dec 13, 2024@02:33:47 Page 2
RABTCH ;HISC/CAH,FPT AISC/MJK,RMO-Batch Report Menu ;3/1/96 13:18
+1 ;;5.0;Radiology/Nuclear Medicine;**47**;Mar 16, 1998;Build 21
1 ;;Select a Batch
+1 WRITE !
KILL RABTCH
SET DIC("S")="I $P(^(0),U,3)=DUZ,'$P(^(0),U,4)"
SET DIC("DR")="2///NOW;3////"_DUZ
SET DIC("A")="Select Batch: "
SET DIC="^RABTCH(74.2,"
SET DIC(0)="AEZLQ"
SET DLAYGO=74.2
+2 DO ^DIC
if Y<0
GOTO Q1
SET RABTCH=+Y
SET RABTCHN=$PIECE(Y,"^",2)
Q1 KILL %,%DT,C,D0,DA,DDH,DI,DIC,DIE,DLAYGO,DQ,DR,I,POP,X,Y
QUIT
+1 ;
2 ;;List Batch Entries
+1 FOR RAPEAT=0:0
WRITE !
if $GET(RAX)["^"
QUIT
SET DIC("A")="Select Batch: "
SET DIC="^RABTCH(74.2,"
SET DIC(0)="AEZMQ"
DO ^DIC
KILL DIC
if Y<1
QUIT
SET RABTCH=+Y
SET ZTRTN="START2^RABTCH"
SET ZTSAVE("RABTCH")=""
WRITE !
DO ZIS^RAUTL
IF 'RAPOP
DO START2
+2 KILL RAPEAT,RAPOP,RAX
DO Q2
+3 QUIT
START2 ; start report processing
+1 USE IO
SET Y(0)=$GET(^RABTCH(74.2,RABTCH,0))
SET RAPGE=0
SET RAX=""
+2 NEW RA1
DO HDR2
+3 FOR I=0:0
SET I=$ORDER(^RABTCH(74.2,RABTCH,"R",I))
if I'>0!(RAX["^")
QUIT
IF $DATA(^(I,0))
SET RARPT=^(0)
SET RAFL=$SELECT($PIECE(RARPT,"^",2)="Y":"*",1:"")
SET RARPT=+RARPT
IF $DATA(^RARPT(RARPT,0))
SET RA0=^(0)
SET RA1=$ORDER(^(1,"B",0))
Begin DoDot:1
+4 IF $Y>(IOSL-4)
if $EXTRACT(IOST)="C"
DO CRCHK^RAORD6
if $DATA(ZTQUEUED)
DO STOPCHK^RAUTL9
if $GET(ZTSTOP)=1
SET RAX="^"
if RAX["^"
QUIT
DO HDR2
+5 SET RACN=$PIECE(RA0,"^",4)
SET RADTI=9999999.9999-$PIECE(RA0,"^",3)
SET RADFN=+$PIECE(RA0,"^",2)
+6 IF $LENGTH($PIECE(RA0,U,1))>12
SET RACNI=$ORDER(^RADPT("ADC1",$PIECE(RA0,U,1),RADFN,RADTI,0))
+7 IF $LENGTH($PIECE(RA0,U,1))'>12
SET RACNI=$ORDER(^RADPT("ADC",$PIECE(RA0,U,1),RADFN,RADTI,0))
+8 NEW RASSAN,RACNDSP
SET RASSAN=$$SSANVAL^RAHLRU1(RADFN,RADTI,RACNI)
+9 SET RACNDSP=$SELECT((RASSAN'=""):RASSAN,1:RACN)
+10 IF $$USESSAN^RAHLRU1()
WRITE !?1,RAFL,?2,RACNDSP
if RA1]""
WRITE "+"
SET Y=$PIECE($PIECE(RA0,"^",3),".")
DO D^RAUTL
WRITE ?22,Y,?35,$SELECT($DATA(^DPT(RADFN,0)):$EXTRACT($PIECE(^(0),"^"),1,29),1:"Unknown")
+11 IF '$$USESSAN^RAHLRU1()
WRITE !?2,RAFL,?3,$JUSTIFY(RACN,4)
if RA1]""
WRITE " +"
SET Y=$PIECE($PIECE(RA0,"^",3),".")
DO D^RAUTL
WRITE ?15,Y,?30,$SELECT($DATA(^DPT(RADFN,0)):$EXTRACT($PIECE(^(0),"^"),1,29),1:"Unknown")
+12 SET Z=""
IF $DATA(^RADPT(RADFN,"DT",RADTI,"P","B",RACN))
IF $ORDER(^(RACN,0))>0
IF $DATA(^RADPT(RADFN,"DT",RADTI,"P",$ORDER(^(0)),0))
SET Z=^(0)
+13 WRITE ?60,$EXTRACT($SELECT($DATA(^VA(200,+$PIECE(Z,"^",12),0)):$PIECE(^(0),"^"),$DATA(^VA(200,+$PIECE(Z,"^",15),0)):$PIECE(^(0),"^"),1:"Unknown"),1,19)
End DoDot:1
Q2 KILL %,DIC,I,RA0,RABTCH,RACN,RADFN,RADTI,RAFL,RAPGE,RARPT,X,Y,Z,ZTQUEUED,ZTSTOP
+1 KILL C,DDH,I,POP,DISYS
+2 DO CLOSE^RAUTL
+3 QUIT
+4 ;
HDR2 ; report header
+1 SET RAPGE=RAPGE+1
+2 if $Y>0
WRITE @IOF
+3 WRITE !,"Batch: ",$PIECE(Y(0),"^"),?30,"Date Created: "
SET Y=$PIECE(Y(0),"^",2)
DO D^RAUTL
WRITE Y,?65,$SELECT($DATA(^VA(200,+$PIECE(Y(0),"^",3),0)):$EXTRACT($PIECE(^(0),"^"),1,14),1:"")
+4 SET Y=$PIECE(Y(0),"^",4)
if Y]""
DO D^RAUTL
WRITE !?30,"Last Printed: ",Y,!!,"* indicates the report has been printed from batch",!
+5 WRITE $$REPEAT^XLFSTR("=",79)
+6 IF $$USESSAN^RAHLRU1()
WRITE !!?1,"Case No.",?22,"Exam Date",?35,"Patient",?60,"Interpreting Phys."
+7 IF $$USESSAN^RAHLRU1()
WRITE !?1,"----------------",?22,"-----------",?35,"--------------------",?60,"------------------"
+8 IF '$$USESSAN^RAHLRU1()
WRITE !!?1,"Case No.",?15,"Exam Date",?30,"Patient",?60,"Interpreting Phys."
+9 IF '$$USESSAN^RAHLRU1()
WRITE !?1,"--------",?15,"---------",?30,"-------",?60,"------------------"
+10 QUIT
3 ;;Print a Batch
+1 ;SET^RAPSET1 is called so that RAMLC is defined and the default print
+2 ;device for report printing can be determined
+3 DO SET^RAPSET1
IF $DATA(XQUIT)
KILL XQUIT
QUIT
+4 WRITE !
SET DIC("A")="Select Batch: "
SET DIC="^RABTCH(74.2,"
SET DIC(0)="AEZMQ"
DO ^DIC
KILL DIC
if Y<0
GOTO Q3
SET RABTCH=+Y
+5 WRITE !!,"Batch: ",$PIECE(Y(0),"^"),?30,"Date Created: "
SET Y=$PIECE(Y(0),"^",2)
DO D^RAUTL
WRITE Y,?65,$SELECT($DATA(^VA(200,+$PIECE(Y(0),"^",3),0)):$EXTRACT($PIECE(^(0),"^"),1,14),1:"")
+6 SET Y=$PIECE(Y(0),"^",4)
if Y]""
DO D^RAUTL
WRITE !?30,"Last Printed: ",Y
ASKPRT READ !!,"Are you sure? No// ",X:DTIME
if '$TEST!(X="")!(X["^")
SET X="N"
if "Nn"[$EXTRACT(X)
GOTO Q3
IF "Yy"'[$EXTRACT(X)
if X'["?"
WRITE *7
WRITE !!?3,"Enter 'YES' to print this batch, or 'NO' not to."
GOTO ASKPRT
BTCH SET ION=$PIECE(RAMLC,"^",10)
SET IOP=$SELECT(ION]"":"Q;"_ION,1:"Q")
+1 SET DIE="^RABTCH(74.2,"
SET DA=RABTCH
SET DR="4///^S X=""NOW"""
DO ^DIE
+2 SET ZTRTN="START^RABTCH"
SET ZTSAVE("RABTCH")=""
+3 WRITE !
DO ZIS^RAUTL
if RAPOP
GOTO Q3
START USE IO
SET U="^"
SET RABT=RABTCH
+1 SET X="T"
SET %DT=""
DO ^%DT
SET DT=Y
+2 FOR RABTI=0:0
SET RABTI=$ORDER(^RABTCH(74.2,RABT,"R",RABTI))
if RABTI'>0
QUIT
IF $DATA(^(RABTI,0))
SET RABTCH=RABT
SET RARPT=+^(0)
SET ^(0)=RARPT_"^Y"
DO PRT^RARTR
Q3 KILL C,D0,DA,DIE,DR,J,K,RABT,RABTI,RADTI,RACN,RADTE,RADFN,RARPT,RABTCH,W,RAPOP
+1 KILL %W,%X,%Y1,D,DI,DIC,DQ,X,Y
+2 KILL DDH,DISYS,I,POP
+3 WRITE !
DO CLOSE^RAUTL
QUIT
+4 ;
4 ;;Remove/Add a Report from a Batch
+1 WRITE !
SET DIC("S")="I $P(^(0),U,3)=DUZ"
SET DIC("A")="Select Batch: "
SET DIC="^RABTCH(74.2,"
SET DIC(0)="AEZMQ"
DO ^DIC
KILL DIC
if Y<0
GOTO Q4
SET DA=+Y
+2 SET DIE="^RABTCH(74.2,"
SET DR="25"
SET DR(2,74.21)=".01"
DO ^DIE
Q4 KILL %,%Y,C,D0,DA,DIE,DR,J,K,RABT,RABTI,RADTI,RACN,RADTE,RADFN,RARPT,RABTCH,W
+1 KILL D,D1,DDH,DI,DIC,DIZ,DLAYGO,DQ,I,X
+2 KILL DDC,DST,DISYS,POP
+3 QUIT
