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

RAPROD1.m

Go to the documentation of this file. 
  1. RAPROD1 ;HISC/FPT,GJC AISC/MJK,RMO-Detailed Exam View ;11/26/96  08:24
  1.  ;;5.0;Radiology/Nuclear Medicine;**15,18,45,77**;Mar 16, 1998;Build 7
  1.  ;last mof by SS for P18 JUN 29 ,00
  1.  ;10/25/2006 BAY/KAM Remedy Call 161846, *77 - correct paging issue
  1. PER ; Display personnel information.
  1.  K DIR,DIROUT,DIRUT,DTOUT,DUOUT N Y
  1.  S DIR(0)="Y",DIR("B")="No"
  1.  S DIR("A")="Do you wish to display all personnel involved"
  1.  D ^DIR S:$D(DIRUT) X="^"
  1.  K DIR,DIROUT,DIRUT,DTOUT,DUOUT I X="^" D Q QUIT
  1.  G:+Y=0 ACT ; (Y=1:Yes,Y=0:No)
  1.  S RAXIT=0 D PERHDR
  1.  S RAXIT=$$PERINFO(RADFN,RADTI,RACNI)
  1.  I RAXIT D Q QUIT
  1.  I $D(RACM) D CMHIST^RAPROD2(RADFN,RADTI,RACNI)
  1.  I RAXIT D Q QUIT
  1. ACT R !!,"Do you wish to display activity log? No// ",X:DTIME S X=$E(X) S:'$T X="^" G Q:X="^" S:X="" X="N" G STAT:"Nn"[X I "Yy"'[X W:X'="?" $C(7) W !!?3,"Enter 'YES' if activity log should be displayed, or 'NO' if not." G ACT
  1.  W !!?23,"*** Exam Activity Log ***",!?2,"Date/Time",?25,"Action",?60,"Computer User",!?3,"Technologist comment",!?2,"---------------------",?25,"------",?60,"-------------"
  1.  N RA18RET S RADD=70.07 F I=0:0 S I=$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"L",I)) Q:I'>0  I $D(^(I,0)) S RAY=^(0),Y=+RAY D ACT1 S RA18RET=$$PUTTCOM3^RAUTL11(RADFN,RADTI,RACNI,I,"",3,78,7,0,1,6,0) S:RA18RET=-1 RAXIT=1 Q:RA18RET=-1  ;P18
  1.  I $D(RAXIT) I RAXIT D Q QUIT  ;P18
  1.  ;
  1.  G STAT:'RARPT W !!?22,"*** Report Activity Log ***",!?2,"Date/Time",?25,"Action",?60,"Computer User",!?2,"---------",?25,"------",?60,"-------------"
  1.  ;10/25/2006 BAY/KAM Remedy Call 161846, *77 - added screen length check to next line
  1.  S RADD=74.01 F I=0:0 S I=$O(^RARPT(RARPT,"L",I)) Q:I'>0  I $D(^(I,0)) S RAY=^(0),Y=+RAY D ACT1 I $$CONTIN^RAUTL11(7)=-1 S RAXIT=1 Q
  1.  ;10/25/2006 BAY/KAM Remedy Call 161846, *77 Added next line
  1.  I $G(RAXIT) D Q QUIT
  1.  W ! S X="",$P(X,"=",80)="" W X K X
  1.  G STAT
  1. ACT1 D D^RAUTL W !?2,Y,?25,$E($P($P(^DD(RADD,2,0),$P(RAY,"^",2)_":",2),";"),1,33),?60,$E($S($D(^VA(200,+$P(RAY,"^",3),0)):$P(^(0),"^"),1:"Unknown"),1,18) Q
  1.  ;
  1. STAT G TEXT:'$D(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"T"))
  1. ASKSTA R !!,"Do you wish to display exam status tracking log? No// ",X:DTIME S X=$E(X) S:'$T X="^" G Q:X="^" S:X="" X="N" G TEXT:"Nn"[X I "Yy"'[X W:X'="?" $C(7) D  G ASKSTA
  1.  . W !!?3,"Enter 'YES' if exam status tracking log should be displayed, or 'NO' if not."
  1.  . Q
  1.  S RAXIT=0 D STATHDR ; print header
  1.  K RAX2 S RACUM=""
  1.  F I=0:0 S I=$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"T",I)) Q:I'>0  I $D(^(I,0)) S RA=^(0),RAX1=+RA D STAT1 Q:$D(RAX2)&('$D(RAMTIME))  Q:RAXIT  S RAX2=RAX1
  1.  Q:RAXIT  W ! S X="",$P(X,"=",80)="" W X K X
  1. TEXT S X=$E(RA("RST")) G Q:X="P"!(X="N")!(X="D")
  1. ASKTXT R !!,"Do you wish to display exam report text? No// ",X:DTIME S X=$E(X) S:'$T!(X="")!(X="^") X="N" G Q:"Nn"[X I "Yy"'[X W:X'="?" $C(7) W !!?3,"Enter 'YES' if report text should be displayed, or 'NO' if not." G ASKTXT
  1.  D DISP^RART1
  1. Q ; kill and quit
  1.  K I,J,POP,RAMTIME,RAPRC,RAPRT,RADFN,RADTI,RACNI,RARPT,RANME,RASSN,RADATE,RADTE,RAST,RACN,RA,RAY,RACI,RADD,RADI,RAMOD,RAX,RAX1,RAX2,RAELAP,RACUM,Z
  1.  K RAXIT,RACM
  1.  Q
  1. STAT1 ; display status tracking info
  1.  K RAELAP I $D(RAX2) S X1=RAX1,X=RAX2 D ELAPSED^RAUTL1 Q:'$D(RAMTIME)  S RAELAP=Y D CUMUL
  1.  S Y=RAX1 D D^RAUTL
  1.  W:$D(RAELAP) ?49,RAELAP,?65,RACUM
  1.  I $Y>(IOSL-4) S RAXIT=$$EOS^RAUTL5() Q:RAXIT  D STATHDR
  1.  W !?2,$S($D(^RA(72,+$P(RA,"^",2),0)):$E($P(^(0),"^"),1,20),1:"Unknown"),?25,Y
  1.  Q
  1. CUMUL ; calculate time frame
  1.  Q:$E(Y)="N"  F RAI=1:1:3 S RA(RAI)=+$P(RACUM,":",RAI)+$P(Y,":",RAI)
  1.  F RAI=3:-1:2 S:RA(RAI)>59 RA(RAI-1)=RA(RAI-1)+1,RA(RAI)=RA(RAI)-60
  1.  S RACUM=$E(RA(1)+100,2,3)_":"_$E(RA(2)+100,2,3)_":"_$E(RA(3)+100,2,3) K RAI,RA(1),RA(2),RA(3)
  1.  Q
  1. STATHDR ; Print status tracking header
  1.  D:'$D(IOF) HOME^%ZIS W @IOF
  1.  W !!,?23,"*** Exam Status Tracking Log ***",!,?47,"Elapsed Time",?61,"Cumulative Time",!,?2,"Status",?25,"Date/Time",?48,"(DD:HH:MM)",?64,"(DD:HH:MM)",!,?2,"------",?25,"---------",?47,"------------",?61,"---------------"
  1.  Q
  1. PERHDR ; Print personnel header
  1.  D:'$D(IOF) HOME^%ZIS W @IOF
  1.  N X,Y S X="*** Imaging Personnel ***"
  1.  S $P(Y,"-",(IOM+1))="" W !?(IOM-$L(X)\2),X,!,Y
  1.  Q
  1. PERINFO(RADFN,RADTI,RACNI) ; Personnel information
  1.  ; Pass back 0 if ok, 1 if interrupt
  1.  Q:'$L(RADFN)!('$L(RADTI))!('$L(RACNI)) 1
  1.  N RA70,RAHD1,RAHD2,RAHD3,RAPIR,RAPIS,RAPRE,RARP,RARPT,RASIR,RASIS
  1.  N RATECH,RATRAN,RAVER
  1.  S RA70=$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0))
  1.  S RARPT=+$P(RA70,"^",17) S:'RARPT RATRAN="No Report"
  1.  S:'RARPT (RAPRE,RAVER,RAPRE("DT"),RAVER("DT"))=""
  1.  I RARPT D
  1.  . S RARPT(0)=$G(^RARPT(RARPT,0))
  1.  . S RARPT("T")=$G(^RARPT(RARPT,"T"))
  1.  . S RATRAN=$S($D(^VA(200,+RARPT("T"),0)):$P(^(0),"^"),1:"")
  1.  . S RAPRE=$S($D(^VA(200,+$P(RARPT(0),"^",13),0)):$P(^(0),"^"),1:"")
  1.  . S RAVER=$S($D(^VA(200,+$P(RARPT(0),"^",9),0)):$P(^(0),"^"),1:"")
  1.  . S RAPRE("DT")=$TR($$FMTE^XLFDT($P(RARPT(0),"^",12),"2F")," /","0")
  1.  . S RAVER("DT")=$TR($$FMTE^XLFDT($P(RARPT(0),"^",7),"2F")," /","0")
  1.  . Q
  1.  S RAPIR=$S($D(^VA(200,+$P(RA70,"^",12),0)):$P(^(0),"^"),1:"")
  1.  S RAPIS=$S($D(^VA(200,+$P(RA70,"^",15),0)):$P(^(0),"^"),1:"")
  1.  S RASIR=+$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"SRR",0))
  1.  S RASIS=+$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"SSR",0))
  1.  S RATECH=+$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"TC",0))
  1.  W !,"Primary Int'g Resident: ",RAPIR
  1.  W !,"Primary Int'g Staff   : ",RAPIS
  1.  W !,"Pre-Verifier: ",RAPRE,"  ",RAPRE("DT")
  1.  W !,"Verifier    : ",RAVER,"  ",RAVER("DT"),!
  1.  S RAHD1="W !,""Secondary Interpreting Resident"",?40,""Secondary Interpreting Staff"""
  1.  S RAHD2="W !,""-------------------------------"",?40,""----------------------------"""
  1.  X RAHD1,RAHD2
  1.  I 'RASIR,('RASIS) W !,"None",?40,"None"
  1.  E  D  Q:RAXIT 1
  1.  . S (RASIR,RASIS)=.001
  1.  . F  D  Q:(('RASIR)&('RASIS))!(RAXIT)
  1.  .. I $Y>(IOSL-4) D  Q:RAXIT
  1.  ... S RAXIT=$$EOS^RAUTL5()
  1.  ... I 'RAXIT D PERHDR X RAHD1,RAHD2
  1.  ... Q
  1.  .. W ! D SECRES:RASIR,SECSTF:RASIS
  1.  .. Q
  1.  . Q
  1.  I $Y>(IOSL-4) D  Q:RAXIT 1
  1.  . S RAXIT=$$EOS^RAUTL5()
  1.  . D:'RAXIT PERHDR
  1.  . Q
  1.  W ! S RAHD3="W !,""Technologist(s)                         Transcriptionist"",!,""---------------                         ----------------""" X RAHD3
  1.  I 'RATECH W !,"None",?40,RATRAN
  1.  E  D  Q:RAXIT 1
  1.  . N RA S RA=0
  1.  . F  S RA=$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"TC",RA)) Q:RA'>0  D  Q:RAXIT
  1.  .. S RATECH(0)=$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"TC",RA,0))
  1.  .. S RATECH=$S($D(^VA(200,+RATECH(0),0)):$P(^(0),"^"),1:"")
  1.  .. I $Y>(IOSL-4) D  Q:RAXIT
  1.  ... S RAXIT=$$EOS^RAUTL5()
  1.  ... I 'RAXIT D PERHDR X RAHD3
  1.  ... Q
  1.  .. W !,RATECH W:RATRAN'=99 ?40,RATRAN S RATRAN=99
  1.  .. Q
  1.  . Q
  1.  Q 0
  1. SECRES ; Secondary Resident data
  1.  S:RASIR=.001 RATXT="None"
  1.  S RASIR=$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"SRR",RASIR))
  1.  I $D(RATXT),('+RASIR) W RATXT
  1.  E  D
  1.  . S RASIR(0)=$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"SRR",RASIR,0))
  1.  . W $S($D(^VA(200,+RASIR(0),0)):$P(^(0),"^"),1:"")
  1.  . Q
  1.  K RATXT
  1.  Q
  1. SECSTF ; Secondary Staff data
  1.  S:RASIS=.001 RATXT="None"
  1.  S RASIS=$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"SSR",RASIS))
  1.  I $D(RATXT),('+RASIS) W ?40,RATXT
  1.  E  D
  1.  . S RASIS(0)=$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"SSR",RASIS,0))
  1.  . W ?40,$S($D(^VA(200,+RASIS(0),0)):$P(^(0),"^"),1:"")
  1.  . Q
  1.  K RATXT
  1.  Q