- 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 Feb 19, 2025@00:00:03 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