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

RAUTL12.m

Go to the documentation of this file.
  1. RAUTL12 ;HISC/CAH,FPT,GJC-Utility Routine ; May 21, 2021@11:13:20
  1. ;;5.0;Radiology/Nuclear Medicine;**75,163,181**;Mar 16, 1998;Build 1
  1. ;
  1. IMGTY(X,Y,Z) ; Determines the Imaging Type
  1. ; 'X' -> either 'e', 'l', or 'p'
  1. ; 'e' means we determine the Imaging Type from the 'Registered
  1. ; Exams' multiple in Rad/Nuc Med Patient file (70)
  1. ; 'l' means that we determine the Imaging Type from data in the
  1. ; Imaging Locations file (79.1)
  1. ; 'p' means that we determine the Imaging Type from data in the
  1. ; Rad/Nuc Med Procedures file (71)
  1. ;
  1. ; 'Y' -> The value of D0 in the above files.
  1. ;
  1. ; 'Z' -> The value of D1 in the Rad/Nuc Med Patient file (70).
  1. ; [ This routine passes back the Imaging Type in the external format ]
  1. N A,B,RAXYZ
  1. I X="e" D
  1. . S A=$G(^RADPT(+$G(Y),"DT",+$G(Z),0)),B=+$P(A,U,2)
  1. . S RAXYZ=$P($G(^RA(79.2,B,0)),U)
  1. . Q
  1. I X="l" D
  1. . S A=$G(^RA(79.1,+$G(Y),0)),B=+$P(A,U,6)
  1. . S RAXYZ=$P($G(^RA(79.2,B,0)),U)
  1. . Q
  1. I X="p" D
  1. . S A=$G(^RAMIS(71,+$G(Y),0)),B=+$P(A,U,12)
  1. . S RAXYZ=$P($G(^RA(79.2,B,0)),U)
  1. . Q
  1. Q RAXYZ
  1. ;
  1. LOCK(X,Y) ; Lock the data global
  1. ; 'X' is the global root
  1. ; 'Y' is the record number
  1. ; KLM/163 - remove setting of RADUZ and ^TMP("RAD LOCS"
  1. N RALCKFLG,XY
  1. ;S RADUZ=+$G(DUZ),
  1. S RALCKFLG=0,XY=X_Y
  1. L +@(XY_")"):5
  1. I '$T S RALCKFLG=1 D
  1. . W !?5,"This record is being edited by another user."
  1. . W !?5,"Try again later!",$C(7)
  1. . Q
  1. ;E D
  1. ;. S ^TMP("RAD LOCKS",$J,RADUZ,X,Y)=""
  1. ;. Q
  1. Q RALCKFLG
  1. ;
  1. UNLOCK(X,Y) ; Unlock the data global
  1. ;KLM/163 - remove setting of RADUZ and ^TMP("RAD LOCS"
  1. N XY ;S RADUZ=+$G(DUZ),
  1. S XY=X_Y L -@(XY_")")
  1. ;K ^TMP("RAD LOCKS",$J,RADUZ,X,Y)
  1. Q
  1. EXTRA(RAQI) ;Input is RAQI (Modifier)
  1. ;Output is AMIS Credit Indicator: RABILAT = BILATERAL,
  1. ;RAPORT = PORTABLE, and RAOR = OPERATING ROOM.
  1. S RAQI=$P($G(^RAMIS(71.2,RAQI,0)),U,2) S:RAQI="b" RABILAT="" S:RAQI="p" RAPORT="" S:RAQI="o" RAOR=""
  1. Q
  1. ;
  1. DESDT(RAPRI) ;Obtain 'Date Desired (NOT appt date)' by DIR call.
  1. ;from DESDT^RAUTL12 gjc@181
  1. ; The 'Date Desired' is passed back in internal format.
  1. ; 75.1 -> Rad Orders File Fld 21 -> Date desired
  1. ; Input: RAPRI = IEN of the procedure being ordered.
  1. ;
  1. N DIR,DIROUT,DIRUT,DUOUT,DTOUT,X,Y
  1. I '$D(RAPKG),($D(ORVP)),($D(ORL)),($D(ORNP)) D PROCMSG^RAUTL5(RAPRI)
  1. F D Q:Y'=""
  1. .S DIR("?",1)="The date desired cannot be greater than 390 days into the future from today."
  1. .S DIR("?",2)=" "
  1. .S DIR("?",3)="The Date Desired or Clinically Indicated Date (CID) is the date for which the"
  1. .S DIR("?",4)="Rad/Nuc Med exam is requested. The CID is required and should not be interpreted"
  1. .S DIR("?")="as an appointment date."
  1. .; 1st parameter is user's input in internal FM date format ('Y' not 'X')
  1. .S DIR(0)="75.1,21^^K:$$FMDIFF^XLFDT(Y,DT,1)>390 X" D ^DIR
  1. .S:$D(DTOUT)#2!($D(DUOUT)#2) Y=-1
  1. .Q
  1. Q Y
  1. ;
  1. PTLOC() ; Current patient location. Used for entry: 'CURRENT PATIENT
  1. ; LOCATION' in the Label Print Fields file. (78.7)
  1. ; 'X' is the patient's DFN. DFN must be a positive integer.
  1. N %,%H,%I,A,B,C,DFN,VAERR,VAIN,X,Y,Y1,Y2,Y3,Y4,Y5
  1. S Y=$$NOW^XLFDT(),Y1=$P(Y,"."),Y2=$E($P(Y,".",2),1,4)
  1. S Y3=$E(Y1,4,5)_"-"_$E(Y1,6,7)_"-"_(1700+$E(Y1,1,3))
  1. S Y4=$E(Y2,1,2)_":"_$E(Y2,3,4)
  1. S Y5=Y3_"@"_Y4,DFN=+$P($G(^RADPT(+$G(RADFN),0)),"^")
  1. Q:'+$G(DFN) "OP Unknown/"_Y5
  1. D INP^VADPT ; If currently an inpatient, grab the ward.
  1. I $P($G(VAIN(4)),"^",2)]"" D Q Y
  1. . S Y=$E($P($G(VAIN(4)),"^",2),1,15)_"/"_Y5
  1. . Q
  1. ; If not currently an inpatient, check if last recorded patient location
  1. ; is a ward. If it is a ward or operating room, pass back 'OP Unknown'.
  1. ; We do not have the benefit of PIMS updating our Rad/Nuc Med files.
  1. S X=+$P($G(^RADPT(+$G(RADFN),"DT",+$G(RADTI),"P",+$G(RACNI),0)),"^",11)
  1. S A=+$P($G(^RAO(75.1,X,0)),"^",22),B=$G(^SC(A,0)),C=$P(B,"^",3)
  1. Q:B']""!("WOR"[C) "OP Unknown/"_Y5
  1. Q $P(B,"^")_" (Req'g Loc)"
  1. ;
  1. IMG() ; Select one/many/all imaging types. This code will be used for ALL
  1. ; the options under the Procedure File Listings option as exported by
  1. ; Rad/Nuc Med version 5. I-Types are not screened.
  1. ; Passes back '1' if I-Type(s) are selected, '0' if nothing selected.
  1. N RADIC,RAQUIT,RAUTIL,X,Y
  1. S RADIC="^RA(79.2,",RADIC(0)="QEAMZ"
  1. S RADIC("A")="Select Imaging Type: ",RADIC("B")="All"
  1. S RAUTIL="RA I-TYPE" W !! D EN1^RASELCT(.RADIC,RAUTIL)
  1. Q $S($D(^TMP($J,"RA I-TYPE"))\10:1,1:0)
  1. ;
  1. LOC(RAX) ; Select one/many/all imaging locations. L-Types are not
  1. ; screened. Passes back '1' if L-Type(s) are selected, '0' if nothing
  1. ; selected. Used for the option: 'Location Parameter List' (4^RASYS)
  1. N RADIC,RAQUIT,RAUTIL,X,Y
  1. S RADIC="^RA(79.1,",RADIC(0)="QEFAMZ"
  1. S RADIC("A")="Select Imaging Location: ",RADIC("B")="All"
  1. S:'RAX RADIC("S")="N RADT S RADT=$P(^(0),""^"",19) I $S('RADT:1,RADT>DT:1,1:0)"
  1. S RAUTIL="RA L-TYPE" W !! D EN1^RASELCT(.RADIC,RAUTIL)
  1. Q $S($D(^TMP($J,"RA L-TYPE"))\10:1,1:0)
  1. ;