Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: RABTCH

RABTCH.m

Go to the documentation of this file.
  1. 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. 1 ;;Select a Batch
  1. 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
  1. D ^DIC G Q1:Y<0 S RABTCH=+Y,RABTCHN=$P(Y,"^",2)
  1. Q1 K %,%DT,C,D0,DA,DDH,DI,DIC,DIE,DLAYGO,DQ,DR,I,POP,X,Y Q
  1. ;
  1. 2 ;;List Batch Entries
  1. 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
  1. K RAPEAT,RAPOP,RAX D Q2
  1. Q
  1. START2 ; start report processing
  1. U IO S Y(0)=$G(^RABTCH(74.2,RABTCH,0)),RAPGE=0,RAX=""
  1. N RA1 D HDR2
  1. 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
  1. .I $Y>(IOSL-4) D:$E(IOST)="C" CRCHK^RAORD6 D:$D(ZTQUEUED) STOPCHK^RAUTL9 S:$G(ZTSTOP)=1 RAX="^" Q:RAX["^" D HDR2
  1. .S RACN=$P(RA0,"^",4),RADTI=9999999.9999-$P(RA0,"^",3),RADFN=+$P(RA0,"^",2)
  1. .I $L($P(RA0,U,1))>12 S RACNI=$O(^RADPT("ADC1",$P(RA0,U,1),RADFN,RADTI,0))
  1. .I $L($P(RA0,U,1))'>12 S RACNI=$O(^RADPT("ADC",$P(RA0,U,1),RADFN,RADTI,0))
  1. .N RASSAN,RACNDSP S RASSAN=$$SSANVAL^RAHLRU1(RADFN,RADTI,RACNI)
  1. .S RACNDSP=$S((RASSAN'=""):RASSAN,1:RACN)
  1. .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")
  1. .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")
  1. .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)
  1. .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)
  1. Q2 K %,DIC,I,RA0,RABTCH,RACN,RADFN,RADTI,RAFL,RAPGE,RARPT,X,Y,Z,ZTQUEUED,ZTSTOP
  1. K C,DDH,I,POP,DISYS
  1. D CLOSE^RAUTL
  1. Q
  1. ;
  1. HDR2 ; report header
  1. S RAPGE=RAPGE+1
  1. W:$Y>0 @IOF
  1. 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:"")
  1. S Y=$P(Y(0),"^",4) D D^RAUTL:Y]"" W !?30,"Last Printed: ",Y,!!,"* indicates the report has been printed from batch",!
  1. W $$REPEAT^XLFSTR("=",79)
  1. I $$USESSAN^RAHLRU1() W !!?1,"Case No.",?22,"Exam Date",?35,"Patient",?60,"Interpreting Phys."
  1. I $$USESSAN^RAHLRU1() W !?1,"----------------",?22,"-----------",?35,"--------------------",?60,"------------------"
  1. I '$$USESSAN^RAHLRU1() W !!?1,"Case No.",?15,"Exam Date",?30,"Patient",?60,"Interpreting Phys."
  1. I '$$USESSAN^RAHLRU1() W !?1,"--------",?15,"---------",?30,"-------",?60,"------------------"
  1. Q
  1. 3 ;;Print a Batch
  1. ;SET^RAPSET1 is called so that RAMLC is defined and the default print
  1. ;device for report printing can be determined
  1. D SET^RAPSET1 I $D(XQUIT) K XQUIT Q
  1. W ! S DIC("A")="Select Batch: ",DIC="^RABTCH(74.2,",DIC(0)="AEZMQ" D ^DIC K DIC G Q3:Y<0 S RABTCH=+Y
  1. 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:"")
  1. S Y=$P(Y(0),"^",4) D D^RAUTL:Y]"" W !?30,"Last Printed: ",Y
  1. 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
  1. BTCH S ION=$P(RAMLC,"^",10),IOP=$S(ION]"":"Q;"_ION,1:"Q")
  1. S DIE="^RABTCH(74.2,",DA=RABTCH,DR="4///^S X=""NOW""" D ^DIE
  1. S ZTRTN="START^RABTCH",ZTSAVE("RABTCH")=""
  1. W ! D ZIS^RAUTL G Q3:RAPOP
  1. START U IO S U="^",RABT=RABTCH
  1. S X="T",%DT="" D ^%DT S DT=Y
  1. 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
  1. Q3 K C,D0,DA,DIE,DR,J,K,RABT,RABTI,RADTI,RACN,RADTE,RADFN,RARPT,RABTCH,W,RAPOP
  1. K %W,%X,%Y1,D,DI,DIC,DQ,X,Y
  1. K DDH,DISYS,I,POP
  1. W ! D CLOSE^RAUTL Q
  1. ;
  1. 4 ;;Remove/Add a Report from a Batch
  1. 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
  1. S DIE="^RABTCH(74.2,",DR="25",DR(2,74.21)=".01" D ^DIE
  1. Q4 K %,%Y,C,D0,DA,DIE,DR,J,K,RABT,RABTI,RADTI,RACN,RADTE,RADFN,RARPT,RABTCH,W
  1. K D,D1,DDH,DI,DIC,DIZ,DLAYGO,DQ,I,X
  1. K DDC,DST,DISYS,POP
  1. Q