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

RASYS1.m

Go to the documentation of this file. 
  1. RASYS1 ;HISC/CAH - Utility to update I-Loc Type to Clinic ;10/30/96  10:00
  1.  ;;5.0;Radiology/Nuclear Medicine;;Mar 16, 1998
  1. EN1(RA791) ;For each imaging loc, get file 44 pointer, DSS ID, Div
  1.  ;and give to MAS to set/reset params on the file 44 entry
  1.  ; Input: -> ien of entry in the 'Imaging Locations' file (79.1)
  1.  N RA44,RA44NM,RA44NM2,RADSS,RADSSNM,RADIV,RAERRCNT,RA44NEW,RATRY
  1.  S RAERRCNT=0,RA44NM2=""
  1.  S RA791(0)=$G(^RA(79.1,+RA791,0))
  1.  S RA44=$P(RA791(0),"^",1) I '$D(^SC(+RA44,0)) D ERR44 Q:RAXIT
  1.  S RA44NM=$P($G(^SC(+RA44,0)),"^",1)
  1.  S RADSS=$P(RA791(0),"^",22) I 'RADSS D ERRDSS Q:RAXIT
  1.  S RADSSNM=$P($G(^DIC(40.7,+RADSS,0)),"^",2)
  1.  S RADIV=$G(^RA(79.1,+RA791,"DIV")) I 'RADIV D ERRDIV Q:RAXIT
  1.  I RAERRCNT Q  ;If this Img Loc has an error, stop here
  1.  ;Call MAS Sched'g routine with img loc data
  1.  S RA44NEW=$$RAD^SCDXUAPI(RA44,"RA") ;returns ien of same or new loc
  1.  I +RA44NEW=-1 D ERRMSG(RA44NEW) Q  ; explain why $$RAD call failed
  1.  I RA44NEW'=RA44 D REPOINT
  1.  S RATRY=$$LOC^SCDXUAPI($S($L(RA44NM2):RA44NM2,1:RA44NM),RADIV,RADSSNM,"RA",RA44)
  1.  I +RATRY=-1 D ERRMSG(RATRY)
  1.  I +RATRY'=-1 D OK
  1.  Q
  1. ERR44 ;bad file 44 pointer
  1.  S RAERRCNT=RAERRCNT+1
  1.  I $Y>(IOSL-6) S RAXIT=$$EOS^RAUTL5() Q:RAXIT  W @IOF
  1.  W !,"Imaging Location file #79.1 internal entry #"_RA44
  1.  W !,"is a broken pointer to Hospital Location file #44."
  1.  W !,"IRM must resolve this problem, then the Rad/Nuc Med ADPAC"
  1.  I $Y>(IOSL-6) S RAXIT=$$EOS^RAUTL5() Q:RAXIT  W @IOF
  1.  W !,"should use the Location Parameter Set-up [RA SYSLOC] option"
  1.  W !,"to edit this Imaging Location, and the Division Parameter"
  1.  W !,"Set-up [RA SYSDIV] option to assign it to a division.",!," "
  1.  I $Y>(IOSL-6) S RAXIT=$$EOS^RAUTL5() Q:RAXIT  W @IOF
  1.  Q
  1. ERRDSS ;bad file 40.7 pointer (DSS ID/Stop Code)
  1.  S RAERRCNT=RAERRCNT+1
  1.  I $Y>(IOSL-6) S RAXIT=$$EOS^RAUTL5() Q:RAXIT  W @IOF
  1.  W !,"Imaging Location file #79.1 entry "_$S($L(RA44NM):RA44NM,1:RA44)_" has a missing"
  1.  W !,"or invalid DSS ID.  The Radiology/Nuclear Medicine ADPAC should"
  1.  W !,"use the Location Parameter Set-up [RA SYSLOC] option to enter"
  1.  I $Y>(IOSL-6) S RAXIT=$$EOS^RAUTL5() Q:RAXIT  W @IOF
  1.  W !,"a valid imaging DSS Code for this imaging location.",!," "
  1.  Q
  1. ERRDIV ;bad or non-existent Division on active imaging loc
  1.  S RAERRCNT=RAERRCNT+1
  1.  I $Y>(IOSL-6) S RAXIT=$$EOS^RAUTL5() Q:RAXIT  W @IOF
  1.  W !,"Imaging Location file #79.1 entry "_$S($L(RA44NM):RA44NM,1:RA44)_" is not assigned"
  1.  W !,"to a Rad/Nuc Med Division. If Imaging exams are to be registered"
  1.  W !,"in this imaging location, or if there are incomplete exams"
  1.  W !,"already registered to this location, the Radiology/Nuclear"
  1.  I $Y>(IOSL-6) S RAXIT=$$EOS^RAUTL5() Q:RAXIT  W @IOF
  1.  W !,"Med ADPAC should use the Division Parameter Set-up [RA SYSDIV]"
  1.  W !,"option to assign this imaging location to the appropriate"
  1.  W !,"Rad/Nuc Med Division.",!," "
  1.  I $Y>(IOSL-4) S RAXIT=$$EOS^RAUTL5() Q:RAXIT  W @IOF
  1.  Q
  1. ERRMSG(RAX) ; Explain why the $$RAD call failed.
  1.  I $Y>(IOSL-6) S RAXIT=$$EOS^RAUTL5() Q:RAXIT  W @IOF
  1.  W !,"Scheduling routine could not reset Hospital Location"
  1.  W !,"file #44 params for Imaging Location "_$S($L(RA44NM2):RA44NM2,1:RA44NM)
  1.  W !,"to agree with params on the Imaging Location file #79.1."
  1.  I $Y>(IOSL-6) S RAXIT=$$EOS^RAUTL5() Q:RAXIT  W @IOF
  1.  W !,"IRM should investigate the cause of this Scheduling error message:"
  1.  W !," * "_$P(RAX,"^",3)_" * ",!," "
  1.  Q
  1. REPOINT ;current img loc points to a file 44 entry with appt patterns
  1.  ;must be repointed to the loc Sched'g returned to us
  1.  ;
  1.  ;call DIE or Silent FM to change .01 fld of file 79.1 to RA44NEW
  1.  ;use equivalent of /// stuff, and give a message about old imaging
  1.  ;loc name changing to new name
  1.  ;
  1.  N RAERR,RAFDA
  1.  S RA44=RA44NEW,RA44NM2=$P($G(^SC(+RA44NEW,0)),"^",1)
  1.  S RAFDA(79.1,RA791_",",.01)=RA44NEW
  1.  D FILE^DIE("K","RAFDA","RAERR")
  1.  I $Y>(IOSL-6) S RAXIT=$$EOS^RAUTL5() Q:RAXIT  W @IOF
  1.  W !,"Imaging Location "_RA44NM_" has appointment patterns, and"
  1.  W !,"cannot be 'pointed to' from a file 79.1 Imaging Location."
  1.  W !,"Imaging Location "_RA44NM_" has been 're-pointed' to"
  1.  I $Y>(IOSL-6) S RAXIT=$$EOS^RAUTL5() Q:RAXIT  W @IOF
  1.  W !,"Hospital Location "_RA44NM2_".",!," "
  1.  Q
  1. OK ;this img loc was processed ok
  1.  I $Y>(IOSL-4) S RAXIT=$$EOS^RAUTL5() Q:RAXIT  W @IOF
  1.  W !,"Imaging Location "_$S($L(RA44NM2):RA44NM2,1:RA44NM)_" is OK.",!," "
  1.  Q