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

RALWKL3.m

Go to the documentation of this file.
  1. RALWKL3 ;HISC/GJC-Workload Reports By Functional Area ;9/23/96 09:00
  1. ;;5.0;Radiology/Nuclear Medicine;;Mar 16, 1998
  1. CHK ; Does the data meet the sort criteria?
  1. S C=$P(RAP0,"^",4),C=$S(C="I":1,C="O":2,C="R":3,1:4)
  1. Q:'$P(RAP0,"^",RAPCE) S RAFLD=$S($D(@("^"_RAFILE_"+$P(RAP0,""^"",RAPCE),0)")):$P(^(0),"^"),1:"Unknown")
  1. I 'RAINPUT Q:'$D(^TMP($J,"RAFLD",RAFLD)) ; not all and not a user selected entry
  1. S RAFLD=$E(RAFLD,1,30)
  1. I RAFILE="SC(" Q:C=1
  1. I (RAFILE="DIC(42,"!(RAFILE="DIC(42.4,")!(RAFILE="DIC(49,")) Q:13'[C
  1. F I=0:0 S I=$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"M",I)) Q:I'>0 I $D(^(I,0)) S RAQI=+$G(^(0)) D EXTRA^RAUTL12(RAQI)
  1. Q:'$D(^RAMIS(71,+$P(RAP0,"^",2),0)) S RAPRI=$G(^(0)),RAPRC=$E($P(RAPRI,"^"),1,40) Q:'$D(^(2)) F I=0:0 S I=$O(^RAMIS(71,+$P(RAP0,"^",2),2,I)) Q:I'>0 I $D(^(I,0)) S RAZ=$G(^(0)),RAMJ=$S($D(^RAMIS(71.1,+RAZ,0)):^(0),1:"") D PRC^RALWKL
  1. Q:'$D(RAMIS(1))
  1. I J=1 S RAMIS=RAMIS(1),RAWT=RAWT(1),RAMUL=RAMUL(1),RAWT=RAWT*RAMUL,RANUM=RAMUL
  1. I J>1 S RANUM=1,RAWT=0,RAMIS=RAMIS(1) F J=1:1 Q:'$D(RAMIS(J)) S I=RAWT(J),RAMUL=RAMUL(J),RAWT=RAWT+(RAMUL*I)
  1. D STORE K RAMIS,RAWT,RAMUL,RAZ,RAMJ,RAMULP,RAMULPFL,RABILAT,RAOR,RAPORT
  1. Q
  1. STORE ; Store off data into ^TMP global.
  1. I $D(ZTQUEUED) D STOPCHK^RAUTL9 S:$G(ZTSTOP)=1 RAXIT=1 Q:RAXIT
  1. I $D(RAOR) S A=25 D AUX^RALWKL
  1. I $D(RAPORT) S A=26 D AUX^RALWKL
  1. I $D(RAMULP) S A="MULP" D AUX^RALWKL
  1. ;----------- Tabulation over all divisions -----------------------------
  1. S X=$G(^TMP($J,"RA",RADIV))
  1. S $P(X,"^",C)=$P(X,"^",C)+RANUM,$P(X,"^",5)=$P(X,"^",5)+RAWT
  1. S ^TMP($J,"RA",RADIV)=X
  1. ;----------- Tabulation over all divisions/imaging types ---------------
  1. S X=$G(^TMP($J,"RA",RADIV,RAIMG))
  1. S $P(X,"^",C)=$P(X,"^",C)+RANUM,$P(X,"^",5)=$P(X,"^",5)+RAWT
  1. S ^TMP($J,"RA",RADIV,RAIMG)=X
  1. ;------------Tabulation over division/i-type/option parameter ----------
  1. I '$D(^TMP($J,"RA",RADIV,RAIMG,RAFLD))#2 D
  1. . S ^TMP($J,"RA",RADIV,RAIMG,RAFLD)="0^0^0^0^0"
  1. S X=$G(^TMP($J,"RA",RADIV,RAIMG,RAFLD))
  1. S $P(X,"^",C)=$P(X,"^",C)+RANUM,$P(X,"^",5)=$P(X,"^",5)+RAWT
  1. S ^TMP($J,"RA",RADIV,RAIMG,RAFLD)=X
  1. ;------------Tabulation over division/option parameter ----------
  1. ; ***** Note new '^TMP($J' subscript (RA1) *****
  1. I '$D(^TMP($J,"RA1",RADIV,RAFLD))#2 D
  1. . S ^TMP($J,"RA1",RADIV,RAFLD)="0^0^0^0^0"
  1. S X=$G(^TMP($J,"RA1",RADIV,RAFLD))
  1. S $P(X,"^",C)=$P(X,"^",C)+RANUM,$P(X,"^",5)=$P(X,"^",5)+RAWT
  1. S ^TMP($J,"RA1",RADIV,RAFLD)=X
  1. ;----------- Tabulation over division/i-types/option parameter/proc ----
  1. I '$D(^TMP($J,"RA",RADIV,RAIMG,RAFLD,RAMIS,RAPRC)) D
  1. . S ^TMP($J,"RA",RADIV,RAIMG,RAFLD,RAMIS,RAPRC)="0^0^0^0^0"
  1. S X=$G(^TMP($J,"RA",RADIV,RAIMG,RAFLD,RAMIS,RAPRC))
  1. S $P(X,"^",C)=$P(X,"^",C)+RANUM,$P(X,"^",5)=$P(X,"^",5)+RAWT
  1. S ^TMP($J,"RA",RADIV,RAIMG,RAFLD,RAMIS,RAPRC)=X
  1. Q
  1. ALLNOTH() ; Do you want access to all entries in the file or just a subset
  1. ; of entries?
  1. ; 'RAPRIM' will be defined if accessing this subroutine through the
  1. ; Options: RA WKLRES (Resident Report) & RA WKLSTAFF (Staff Report)
  1. N RAINPUT K DIR,X,Y S DIR(0)="YA",DIR("B")="Yes"
  1. S DIR("A")="Do you wish to include all "_$S($G(RAPRIM)=1:"Primary ",1:"")_$G(RATITLE)_"s? "
  1. I $G(RATITLE)="Interpreting Staff" S DIR("A")="Do you wish to include all"_$S($G(RAPRIM)=1:" Primary",1:"")_" Interpreting Staff? "
  1. S DIR("?",1)="Enter 'Yes' to select all entries in the file."
  1. S DIR("?")="Enter 'No' to select a subset of entries in the file."
  1. W ! D ^DIR K DIR Q:$D(DIRUT) ""
  1. S RAINPUT=+Y K DIROUT,DIRUT,DTOUT,DUOUT,X,Y
  1. Q RAINPUT
  1. ONE(Z) ; Check if only one entry in the file. (File specs passed in.)
  1. N RAXREF,RAZERO,X,X1,Y,Y1
  1. S RAXREF="^"_Z_"""B"",",RAZERO="^"_Z
  1. S X=$O(@(RAXREF_""""")")) Q:X']""
  1. S Y=$O(@(RAXREF_""""_X_""")")) Q:Y]""
  1. S X1=+$O(@(RAXREF_""""_X_""",0)")) Q:'X1
  1. S:Z="SC(" Y1=$P($G(@(RAZERO_X1_",0)")),"^")
  1. S:Z'="SC(" Y1=$P($G(@(RAZERO_X1_",0)")),"^")
  1. S ^TMP($J,"RAFLD",Y1,X1)="",RAINPUT=0
  1. Q
  1. SELECT ; Select one-many-all entries from a specific file.
  1. Q:$D(^TMP($J,"RAFLD")) ; Only one entry in the file
  1. N RADIC,RAUTIL S RADIC="^"_RAFILE,RADIC(0)="QEAMZ"
  1. S RADIC("A")="Select "_$G(RATITLE)_": "
  1. S RAUTIL="RAFLD",RAINPUT=$$ALLNOTH()
  1. S:RAINPUT="" RAXIT=1 Q:RAXIT
  1. D:'RAINPUT EN1^RASELCT(.RADIC,RAUTIL,"",RAINPUT)
  1. S RAXIT=RAQUIT K:RAXIT RAINPUT Q:RAXIT
  1. Q