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

RA45PST2.m

Go to the documentation of this file.
  1. RA45PST2 ;Hines OI/GJC - Post-init 'B', patch 45 ;10/10/03 06:32
  1. VERSION ;;5.0;Radiology/Nuclear Medicine;**45**;Mar 16, 1998
  1. ;
  1. ENQ2 ;The second process must be tasked off that will identify all the
  1. ;non-parent Rad/Nuc Med orderable items (OI) in file 101.43 checking
  1. ;them to see if barium, oral cholecystogram or unspecified contrast
  1. ;media happen to be associated contrasts.
  1. ;
  1. ;If no associations move onto the next OI and check for CMs
  1. ;
  1. ;If yes, update the procedure in file 71; add barium, oral
  1. ;cholecystografic or unspecified contrast media to the CONTRAST MEDIA
  1. ;(#125) multiple in file 71. All successful and unsuccessful updates
  1. ;will be presented to the user in the form of an email message.
  1. ;(Failure to update occurs when a record cannot be locked)
  1. ;
  1. ;Finally, the Rad/Nuc Med Procedure (71) file will be synchronized with
  1. ;the Orderable Items (101.43) file.
  1. ;
  1. ;Note: since parent procedure records resident in the OI file prior
  1. ;to RA*5*45 did not have CM associations synchronizing files 101.43 &
  1. ;71 will occur just before processing is finished.
  1. ;
  1. S:$D(ZTQUEUED) ZTREQ="@" S RAX="",(RACT,ZTSTOP)=0
  1. F S RAX=$O(^ORD(101.43,"S.XRAY",RAX)) Q:RAX="" D Q:ZTSTOP
  1. .S RAY=0 F S RAY=$O(^ORD(101.43,"S.XRAY",RAX,RAY)) Q:'RAY D
  1. ..S RAOIRA=$G(^ORD(101.43,RAY,"RA")),RAOICM=$P(RAOIRA,U) Q:RAOICM=""
  1. ..S RAOIPT=$P(RAOIRA,U,2) Q:("^B^P^")[("^"_RAOIPT_"^")
  1. ..;parents have no descendents in 101.43 & broads have no CPTs quit
  1. ..S RAOI=$G(^ORD(101.43,RAY,0)),RAOI(2)=$P(RAOI,U,2)
  1. ..Q:$P(RAOI(2),";",2)'="99RAP" ;just to be on the safe side...
  1. ..;update file 71 with CM data, lock the record if lock fails quit
  1. ..;record will not be updated in this case
  1. ..L +^RAMIS(71,+RAOI(2)):30
  1. ..I '$T D SETMP(+RAOI(2),$E($P(RAOI,U),1,40),"",RAOICM,"*failed*",1) Q
  1. ..F RAI=1:1:$L(RAOICM) D FILECM(+RAOI(2),$E(RAOICM,RAI),RAI)
  1. ..L -^RAMIS(71,+RAOI(2)) ;unlock
  1. ..;identify those records in file 71 that have been updated; the
  1. ..;user will be made aware of rad/nuc med procedure updates via email
  1. ..S RAMIS(0)=$G(^RAMIS(71,+RAOI(2),0)),RAPNAME=$P(RAMIS(0),U)
  1. ..S RACT=RACT+1 S:RACT#200=0 ZTSTOP=$$S^%ZTLOAD()
  1. ..S RACPT=$P($$CPT^ICPTCOD($P(RAMIS(0),U,9)),U),RACPT=$S(RACPT=-1:"none",1:RACPT)
  1. ..D SETMP(+RAOI(2),$E(RAPNAME,1,40),RACPT,RAOICM,"*done*",1)
  1. ..Q
  1. .Q
  1. ;
  1. ;if the user stopped this process via TaskMan (TM) inform the user
  1. D:ZTSTOP=1 STOP
  1. ;
  1. ;if there has been data updated, let the user know through an email
  1. ;even if the user stopped the task via TaskMan (TM)
  1. I +$O(^TMP("RA PROC UPDATE 45",$J,0)) D MAILQ2^RA45PST(1,"RA*5*45: Update Rad/NM CM definitions from Ord. Item CM definitions")
  1. ;
  1. ;user stopped the process, do not proceed kill variables and quit
  1. I ZTSTOP=1 D KILLQ2 Q
  1. ;
  1. ;make sure the all from file 71 get updated in file 101.43; ZTSTOP
  1. ;exists and is set to zero.
  1. ;RAO7MFN takes care of: skipping broad procedures, skipping inactive
  1. ;procedures, & flagging parent procedure with contrasts if a non-broad
  1. ;descendent has contrasts.
  1. S (RACT,RAY)=0 K ^TMP("RA PROC UPDATE 45",$J)
  1. F S RAY=$O(^RAMIS(71,RAY)) Q:'RAY D Q:ZTSTOP
  1. .S RAMIS(0)=$G(^RAMIS(71,RAY,0)),RAPNAME=$E($P(RAMIS(0),U),1,40)
  1. .S RASTAT=+$G(^RAMIS(71,RAY,"I")),RASTAT=$S(RASTAT=0:1,RASTAT>DT:1,1:0)
  1. .S RAPTY=$P(RAMIS(0),U,6),RAPTY=$S(RAPTY="P":"(p)",1:"")
  1. .S RACPTB=$P($$CPT^ICPTCOD($P(RAMIS(0),U,9)),U),RACPTB=$S(RACPTB=-1:"none",1:RACPTB),RAPNAME=RAPNAME_RAPTY
  1. .;build Rad/Nuc Med procedure file based contrast media string
  1. .S (I,RACM)=""
  1. .F S I=$O(^RAMIS(71,RAY,"CM","B",I)) Q:I="" S RACM=RACM_I
  1. .;
  1. .;update file 71 with CM data; attempt lock, if lock fails quit
  1. .;record will not be updated if a lock attempt fails
  1. .K I S RACT=RACT+1 S:RACT#50=0 ZTSTOP=$$S^%ZTLOAD()
  1. .Q:ZTSTOP L +^RAMIS(71,RAY):30
  1. .I '$T D SETMP(RAY,RAPNAME,RACPTB,RACM,"*failed*",2) Q
  1. .D PROC^RAO7MFN(0,71,"1^"_RASTAT,RAY_"^"_RAPNAME)
  1. .;1st parameter (param) indicates a single procedure update; 2nd param
  1. .;indicates the file being edited (RAD/NUC MED PROCEDURE); 3rd param
  1. .;indicates the 'before & after' status of the procedure after an
  1. .;edit event ('before' status always active to guarantee unconditional
  1. .;OI file updates); 4th param indicates the IEN (1st piece) and name
  1. .;(2nd piece) of the procedure in file 71
  1. .L -^RAMIS(71,RAY) ;unlock...
  1. .D SETMP(RAY,RAPNAME,RACPTB,RACM,"*done*",2)
  1. .Q
  1. ;
  1. ;if the user stopped this process via TaskMan (TM) inform the user
  1. D:ZTSTOP=1 STOP
  1. ;
  1. ;if there has been data updated, let the user know through an email
  1. I +$O(^TMP("RA PROC UPDATE 45",$J,0)) D MAILQ2^RA45PST(2,"RA*5*45: Synch up the Rad/Nuc Med Procedure & Orderable Item files")
  1. ;
  1. KILLQ2 ;kill & quit
  1. K RACM,RACT,RACPT,RACPTB,RAI,RAMIS,RAOI,RAOICM,RAOIPT,RAOIRA,RAPNAME
  1. K RAPTY,RASTAT,RAX,RAY,ZTSTOP,^TMP("RA PROC UPDATE 45",$J)
  1. Q
  1. ;
  1. FILECM(RAIEN,RACM,RAI) ;Files contrast medium into the CONTRAST MEDIA (#125)
  1. ;field in the RAD/NUC MED PROCEDURE (#71) file. Set the 'CONTRAST MEDIA
  1. ;USED' field (20) to 'Y'es on the initial pass into FILECM (when RAI=1)
  1. ;Input
  1. ; RAIEN=IEN of rad/nuc med procedure in file 71
  1. ; RACM=I (Iodinated ionic); N (Iodinated non-ionic); L (Gadolinium);
  1. ; C (Oral Cholecystographic); G (Gastrografin); B (Barium);
  1. ; M (unspecified contrast media)
  1. ; RAI=position of a particular character in a data string
  1. ;
  1. Q:$D(^RAMIS(71,RAIEN,"CM","B",RACM))\10 ;prevents duplicate records
  1. K RAFDA S RAD1=+$O(^RAMIS(71,RAIEN,"CM",$C(32)),-1)+1
  1. S:RAI=1 RAFDA(71,RAIEN_",",20)="Y"
  1. S RAFDA(71.0125,"+"_RAD1_","_RAIEN_",",.01)=RACM
  1. D UPDATE^DIE("","RAFDA") K RAD1,RAFDA
  1. Q
  1. ;
  1. SETMP(SUB,NME,CPT,CMU,MSG,FMT) ;set the ^TMP("RA PROC UPDATE 45",$J) global
  1. ;with procedure information
  1. ;input: SUB=IEN of Rad/Nuc Med Procedure (Orderable Item ID fld value)
  1. ; NME=procedure name
  1. ; CPT=procedure CPT
  1. ; CMU=contrast media (see RACM definition for FILECM subroutine)
  1. ; MSG=indicator *done* or *failed*
  1. ; FMT=format for data in email(column position 80 chars wide max)
  1. N I,RAX,RAY S $P(RAY," ",81)="",RAX=""
  1. F I=1:1:$L(CMU) S RAX=RAX_$E(CMU,I)_$S($L(CMU)>I:",",1:"")
  1. S $E(RAY,1,8)=$G(MSG),$E(RAY,10,50)=$G(NME)
  1. S:FMT=1 $E(RAY,52,59)=$G(CPT)
  1. S:FMT=2 $E(RAY,55,60)=$G(CPT)
  1. S:FMT=1 $E(RAY,60,70)=$G(RAX)
  1. S:FMT=2 $E(RAY,65,77)=$G(RAX)
  1. S ^TMP("RA PROC UPDATE 45",$J,SUB)=RAY
  1. Q
  1. ;
  1. STOP ;inform the user that the task has been stopped
  1. S ^TMP("RA PROC UPDATE 45",$J,$$SUB())="RA*5*45's Orderable Items-Rad/Nuc Med Proc. synchronization has been terminated prematurely"
  1. Q
  1. ;
  1. SUB() ;return the next available subscript (arithmetic progression)
  1. Q +$O(^TMP("RA PROC UPDATE 45",$J,$C(32)),-1)+1
  1. ;