RA45PST2 ;Hines OI/GJC - Post-init 'B', patch 45 ;10/10/03 06:32
VERSION ;;5.0;Radiology/Nuclear Medicine;**45**;Mar 16, 1998
;
ENQ2 ;The second process must be tasked off that will identify all the
;non-parent Rad/Nuc Med orderable items (OI) in file 101.43 checking
;them to see if barium, oral cholecystogram or unspecified contrast
;media happen to be associated contrasts.
;
;If no associations move onto the next OI and check for CMs
;
;If yes, update the procedure in file 71; add barium, oral
;cholecystografic or unspecified contrast media to the CONTRAST MEDIA
;(#125) multiple in file 71. All successful and unsuccessful updates
;will be presented to the user in the form of an email message.
;(Failure to update occurs when a record cannot be locked)
;
;Finally, the Rad/Nuc Med Procedure (71) file will be synchronized with
;the Orderable Items (101.43) file.
;
;Note: since parent procedure records resident in the OI file prior
;to RA*5*45 did not have CM associations synchronizing files 101.43 &
;71 will occur just before processing is finished.
;
S:$D(ZTQUEUED) ZTREQ="@" S RAX="",(RACT,ZTSTOP)=0
F S RAX=$O(^ORD(101.43,"S.XRAY",RAX)) Q:RAX="" D Q:ZTSTOP
.S RAY=0 F S RAY=$O(^ORD(101.43,"S.XRAY",RAX,RAY)) Q:'RAY D
..S RAOIRA=$G(^ORD(101.43,RAY,"RA")),RAOICM=$P(RAOIRA,U) Q:RAOICM=""
..S RAOIPT=$P(RAOIRA,U,2) Q:("^B^P^")[("^"_RAOIPT_"^")
..;parents have no descendents in 101.43 & broads have no CPTs quit
..S RAOI=$G(^ORD(101.43,RAY,0)),RAOI(2)=$P(RAOI,U,2)
..Q:$P(RAOI(2),";",2)'="99RAP" ;just to be on the safe side...
..;update file 71 with CM data, lock the record if lock fails quit
..;record will not be updated in this case
..L +^RAMIS(71,+RAOI(2)):30
..I '$T D SETMP(+RAOI(2),$E($P(RAOI,U),1,40),"",RAOICM,"*failed*",1) Q
..F RAI=1:1:$L(RAOICM) D FILECM(+RAOI(2),$E(RAOICM,RAI),RAI)
..L -^RAMIS(71,+RAOI(2)) ;unlock
..;identify those records in file 71 that have been updated; the
..;user will be made aware of rad/nuc med procedure updates via email
..S RAMIS(0)=$G(^RAMIS(71,+RAOI(2),0)),RAPNAME=$P(RAMIS(0),U)
..S RACT=RACT+1 S:RACT#200=0 ZTSTOP=$$S^%ZTLOAD()
..S RACPT=$P($$CPT^ICPTCOD($P(RAMIS(0),U,9)),U),RACPT=$S(RACPT=-1:"none",1:RACPT)
..D SETMP(+RAOI(2),$E(RAPNAME,1,40),RACPT,RAOICM,"*done*",1)
..Q
.Q
;
;if the user stopped this process via TaskMan (TM) inform the user
D:ZTSTOP=1 STOP
;
;if there has been data updated, let the user know through an email
;even if the user stopped the task via TaskMan (TM)
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")
;
;user stopped the process, do not proceed kill variables and quit
I ZTSTOP=1 D KILLQ2 Q
;
;make sure the all from file 71 get updated in file 101.43; ZTSTOP
;exists and is set to zero.
;RAO7MFN takes care of: skipping broad procedures, skipping inactive
;procedures, & flagging parent procedure with contrasts if a non-broad
;descendent has contrasts.
S (RACT,RAY)=0 K ^TMP("RA PROC UPDATE 45",$J)
F S RAY=$O(^RAMIS(71,RAY)) Q:'RAY D Q:ZTSTOP
.S RAMIS(0)=$G(^RAMIS(71,RAY,0)),RAPNAME=$E($P(RAMIS(0),U),1,40)
.S RASTAT=+$G(^RAMIS(71,RAY,"I")),RASTAT=$S(RASTAT=0:1,RASTAT>DT:1,1:0)
.S RAPTY=$P(RAMIS(0),U,6),RAPTY=$S(RAPTY="P":"(p)",1:"")
.S RACPTB=$P($$CPT^ICPTCOD($P(RAMIS(0),U,9)),U),RACPTB=$S(RACPTB=-1:"none",1:RACPTB),RAPNAME=RAPNAME_RAPTY
.;build Rad/Nuc Med procedure file based contrast media string
.S (I,RACM)=""
.F S I=$O(^RAMIS(71,RAY,"CM","B",I)) Q:I="" S RACM=RACM_I
.;
.;update file 71 with CM data; attempt lock, if lock fails quit
.;record will not be updated if a lock attempt fails
.K I S RACT=RACT+1 S:RACT#50=0 ZTSTOP=$$S^%ZTLOAD()
.Q:ZTSTOP L +^RAMIS(71,RAY):30
.I '$T D SETMP(RAY,RAPNAME,RACPTB,RACM,"*failed*",2) Q
.D PROC^RAO7MFN(0,71,"1^"_RASTAT,RAY_"^"_RAPNAME)
.;1st parameter (param) indicates a single procedure update; 2nd param
.;indicates the file being edited (RAD/NUC MED PROCEDURE); 3rd param
.;indicates the 'before & after' status of the procedure after an
.;edit event ('before' status always active to guarantee unconditional
.;OI file updates); 4th param indicates the IEN (1st piece) and name
.;(2nd piece) of the procedure in file 71
.L -^RAMIS(71,RAY) ;unlock...
.D SETMP(RAY,RAPNAME,RACPTB,RACM,"*done*",2)
.Q
;
;if the user stopped this process via TaskMan (TM) inform the user
D:ZTSTOP=1 STOP
;
;if there has been data updated, let the user know through an email
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")
;
KILLQ2 ;kill & quit
K RACM,RACT,RACPT,RACPTB,RAI,RAMIS,RAOI,RAOICM,RAOIPT,RAOIRA,RAPNAME
K RAPTY,RASTAT,RAX,RAY,ZTSTOP,^TMP("RA PROC UPDATE 45",$J)
Q
;
FILECM(RAIEN,RACM,RAI) ;Files contrast medium into the CONTRAST MEDIA (#125)
;field in the RAD/NUC MED PROCEDURE (#71) file. Set the 'CONTRAST MEDIA
;USED' field (20) to 'Y'es on the initial pass into FILECM (when RAI=1)
;Input
; RAIEN=IEN of rad/nuc med procedure in file 71
; RACM=I (Iodinated ionic); N (Iodinated non-ionic); L (Gadolinium);
; C (Oral Cholecystographic); G (Gastrografin); B (Barium);
; M (unspecified contrast media)
; RAI=position of a particular character in a data string
;
Q:$D(^RAMIS(71,RAIEN,"CM","B",RACM))\10 ;prevents duplicate records
K RAFDA S RAD1=+$O(^RAMIS(71,RAIEN,"CM",$C(32)),-1)+1
S:RAI=1 RAFDA(71,RAIEN_",",20)="Y"
S RAFDA(71.0125,"+"_RAD1_","_RAIEN_",",.01)=RACM
D UPDATE^DIE("","RAFDA") K RAD1,RAFDA
Q
;
SETMP(SUB,NME,CPT,CMU,MSG,FMT) ;set the ^TMP("RA PROC UPDATE 45",$J) global
;with procedure information
;input: SUB=IEN of Rad/Nuc Med Procedure (Orderable Item ID fld value)
; NME=procedure name
; CPT=procedure CPT
; CMU=contrast media (see RACM definition for FILECM subroutine)
; MSG=indicator *done* or *failed*
; FMT=format for data in email(column position 80 chars wide max)
N I,RAX,RAY S $P(RAY," ",81)="",RAX=""
F I=1:1:$L(CMU) S RAX=RAX_$E(CMU,I)_$S($L(CMU)>I:",",1:"")
S $E(RAY,1,8)=$G(MSG),$E(RAY,10,50)=$G(NME)
S:FMT=1 $E(RAY,52,59)=$G(CPT)
S:FMT=2 $E(RAY,55,60)=$G(CPT)
S:FMT=1 $E(RAY,60,70)=$G(RAX)
S:FMT=2 $E(RAY,65,77)=$G(RAX)
S ^TMP("RA PROC UPDATE 45",$J,SUB)=RAY
Q
;
STOP ;inform the user that the task has been stopped
S ^TMP("RA PROC UPDATE 45",$J,$$SUB())="RA*5*45's Orderable Items-Rad/Nuc Med Proc. synchronization has been terminated prematurely"
Q
;
SUB() ;return the next available subscript (arithmetic progression)
Q +$O(^TMP("RA PROC UPDATE 45",$J,$C(32)),-1)+1
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRA45PST2 6743 printed Dec 13, 2024@02:33:22 Page 2
RA45PST2 ;Hines OI/GJC - Post-init 'B', patch 45 ;10/10/03 06:32
VERSION ;;5.0;Radiology/Nuclear Medicine;**45**;Mar 16, 1998
+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
+2 ;them to see if barium, oral cholecystogram or unspecified contrast
+3 ;media happen to be associated contrasts.
+4 ;
+5 ;If no associations move onto the next OI and check for CMs
+6 ;
+7 ;If yes, update the procedure in file 71; add barium, oral
+8 ;cholecystografic or unspecified contrast media to the CONTRAST MEDIA
+9 ;(#125) multiple in file 71. All successful and unsuccessful updates
+10 ;will be presented to the user in the form of an email message.
+11 ;(Failure to update occurs when a record cannot be locked)
+12 ;
+13 ;Finally, the Rad/Nuc Med Procedure (71) file will be synchronized with
+14 ;the Orderable Items (101.43) file.
+15 ;
+16 ;Note: since parent procedure records resident in the OI file prior
+17 ;to RA*5*45 did not have CM associations synchronizing files 101.43 &
+18 ;71 will occur just before processing is finished.
+19 ;
+20 if $DATA(ZTQUEUED)
SET ZTREQ="@"
SET RAX=""
SET (RACT,ZTSTOP)=0
+21 FOR
SET RAX=$ORDER(^ORD(101.43,"S.XRAY",RAX))
if RAX=""
QUIT
Begin DoDot:1
+22 SET RAY=0
FOR
SET RAY=$ORDER(^ORD(101.43,"S.XRAY",RAX,RAY))
if 'RAY
QUIT
Begin DoDot:2
+23 SET RAOIRA=$GET(^ORD(101.43,RAY,"RA"))
SET RAOICM=$PIECE(RAOIRA,U)
if RAOICM=""
QUIT
+24 SET RAOIPT=$PIECE(RAOIRA,U,2)
if ("^B^P^")[("^"_RAOIPT_"^")
QUIT
+25 ;parents have no descendents in 101.43 & broads have no CPTs quit
+26 SET RAOI=$GET(^ORD(101.43,RAY,0))
SET RAOI(2)=$PIECE(RAOI,U,2)
+27 ;just to be on the safe side...
if $PIECE(RAOI(2),";",2)'="99RAP"
QUIT
+28 ;update file 71 with CM data, lock the record if lock fails quit
+29 ;record will not be updated in this case
+30 LOCK +^RAMIS(71,+RAOI(2)):30
+31 IF '$TEST
DO SETMP(+RAOI(2),$EXTRACT($PIECE(RAOI,U),1,40),"",RAOICM,"*failed*",1)
QUIT
+32 FOR RAI=1:1:$LENGTH(RAOICM)
DO FILECM(+RAOI(2),$EXTRACT(RAOICM,RAI),RAI)
+33 ;unlock
LOCK -^RAMIS(71,+RAOI(2))
+34 ;identify those records in file 71 that have been updated; the
+35 ;user will be made aware of rad/nuc med procedure updates via email
+36 SET RAMIS(0)=$GET(^RAMIS(71,+RAOI(2),0))
SET RAPNAME=$PIECE(RAMIS(0),U)
+37 SET RACT=RACT+1
if RACT#200=0
SET ZTSTOP=$$S^%ZTLOAD()
+38 SET RACPT=$PIECE($$CPT^ICPTCOD($PIECE(RAMIS(0),U,9)),U)
SET RACPT=$SELECT(RACPT=-1:"none",1:RACPT)
+39 DO SETMP(+RAOI(2),$EXTRACT(RAPNAME,1,40),RACPT,RAOICM,"*done*",1)
+40 QUIT
End DoDot:2
+41 QUIT
End DoDot:1
if ZTSTOP
QUIT
+42 ;
+43 ;if the user stopped this process via TaskMan (TM) inform the user
+44 if ZTSTOP=1
DO STOP
+45 ;
+46 ;if there has been data updated, let the user know through an email
+47 ;even if the user stopped the task via TaskMan (TM)
+48 IF +$ORDER(^TMP("RA PROC UPDATE 45",$JOB,0))
DO MAILQ2^RA45PST(1,"RA*5*45: Update Rad/NM CM definitions from Ord. Item CM definitions")
+49 ;
+50 ;user stopped the process, do not proceed kill variables and quit
+51 IF ZTSTOP=1
DO KILLQ2
QUIT
+52 ;
+53 ;make sure the all from file 71 get updated in file 101.43; ZTSTOP
+54 ;exists and is set to zero.
+55 ;RAO7MFN takes care of: skipping broad procedures, skipping inactive
+56 ;procedures, & flagging parent procedure with contrasts if a non-broad
+57 ;descendent has contrasts.
+58 SET (RACT,RAY)=0
KILL ^TMP("RA PROC UPDATE 45",$JOB)
+59 FOR
SET RAY=$ORDER(^RAMIS(71,RAY))
if 'RAY
QUIT
Begin DoDot:1
+60 SET RAMIS(0)=$GET(^RAMIS(71,RAY,0))
SET RAPNAME=$EXTRACT($PIECE(RAMIS(0),U),1,40)
+61 SET RASTAT=+$GET(^RAMIS(71,RAY,"I"))
SET RASTAT=$SELECT(RASTAT=0:1,RASTAT>DT:1,1:0)
+62 SET RAPTY=$PIECE(RAMIS(0),U,6)
SET RAPTY=$SELECT(RAPTY="P":"(p)",1:"")
+63 SET RACPTB=$PIECE($$CPT^ICPTCOD($PIECE(RAMIS(0),U,9)),U)
SET RACPTB=$SELECT(RACPTB=-1:"none",1:RACPTB)
SET RAPNAME=RAPNAME_RAPTY
+64 ;build Rad/Nuc Med procedure file based contrast media string
+65 SET (I,RACM)=""
+66 FOR
SET I=$ORDER(^RAMIS(71,RAY,"CM","B",I))
if I=""
QUIT
SET RACM=RACM_I
+67 ;
+68 ;update file 71 with CM data; attempt lock, if lock fails quit
+69 ;record will not be updated if a lock attempt fails
+70 KILL I
SET RACT=RACT+1
if RACT#50=0
SET ZTSTOP=$$S^%ZTLOAD()
+71 if ZTSTOP
QUIT
LOCK +^RAMIS(71,RAY):30
+72 IF '$TEST
DO SETMP(RAY,RAPNAME,RACPTB,RACM,"*failed*",2)
QUIT
+73 DO PROC^RAO7MFN(0,71,"1^"_RASTAT,RAY_"^"_RAPNAME)
+74 ;1st parameter (param) indicates a single procedure update; 2nd param
+75 ;indicates the file being edited (RAD/NUC MED PROCEDURE); 3rd param
+76 ;indicates the 'before & after' status of the procedure after an
+77 ;edit event ('before' status always active to guarantee unconditional
+78 ;OI file updates); 4th param indicates the IEN (1st piece) and name
+79 ;(2nd piece) of the procedure in file 71
+80 ;unlock...
LOCK -^RAMIS(71,RAY)
+81 DO SETMP(RAY,RAPNAME,RACPTB,RACM,"*done*",2)
+82 QUIT
End DoDot:1
if ZTSTOP
QUIT
+83 ;
+84 ;if the user stopped this process via TaskMan (TM) inform the user
+85 if ZTSTOP=1
DO STOP
+86 ;
+87 ;if there has been data updated, let the user know through an email
+88 IF +$ORDER(^TMP("RA PROC UPDATE 45",$JOB,0))
DO MAILQ2^RA45PST(2,"RA*5*45: Synch up the Rad/Nuc Med Procedure & Orderable Item files")
+89 ;
KILLQ2 ;kill & quit
+1 KILL RACM,RACT,RACPT,RACPTB,RAI,RAMIS,RAOI,RAOICM,RAOIPT,RAOIRA,RAPNAME
+2 KILL RAPTY,RASTAT,RAX,RAY,ZTSTOP,^TMP("RA PROC UPDATE 45",$JOB)
+3 QUIT
+4 ;
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
+2 ;USED' field (20) to 'Y'es on the initial pass into FILECM (when RAI=1)
+3 ;Input
+4 ; RAIEN=IEN of rad/nuc med procedure in file 71
+5 ; RACM=I (Iodinated ionic); N (Iodinated non-ionic); L (Gadolinium);
+6 ; C (Oral Cholecystographic); G (Gastrografin); B (Barium);
+7 ; M (unspecified contrast media)
+8 ; RAI=position of a particular character in a data string
+9 ;
+10 ;prevents duplicate records
if $DATA(^RAMIS(71,RAIEN,"CM","B",RACM))\10
QUIT
+11 KILL RAFDA
SET RAD1=+$ORDER(^RAMIS(71,RAIEN,"CM",$CHAR(32)),-1)+1
+12 if RAI=1
SET RAFDA(71,RAIEN_",",20)="Y"
+13 SET RAFDA(71.0125,"+"_RAD1_","_RAIEN_",",.01)=RACM
+14 DO UPDATE^DIE("","RAFDA")
KILL RAD1,RAFDA
+15 QUIT
+16 ;
SETMP(SUB,NME,CPT,CMU,MSG,FMT) ;set the ^TMP("RA PROC UPDATE 45",$J) global
+1 ;with procedure information
+2 ;input: SUB=IEN of Rad/Nuc Med Procedure (Orderable Item ID fld value)
+3 ; NME=procedure name
+4 ; CPT=procedure CPT
+5 ; CMU=contrast media (see RACM definition for FILECM subroutine)
+6 ; MSG=indicator *done* or *failed*
+7 ; FMT=format for data in email(column position 80 chars wide max)
+8 NEW I,RAX,RAY
SET $PIECE(RAY," ",81)=""
SET RAX=""
+9 FOR I=1:1:$LENGTH(CMU)
SET RAX=RAX_$EXTRACT(CMU,I)_$SELECT($LENGTH(CMU)>I:",",1:"")
+10 SET $EXTRACT(RAY,1,8)=$GET(MSG)
SET $EXTRACT(RAY,10,50)=$GET(NME)
+11 if FMT=1
SET $EXTRACT(RAY,52,59)=$GET(CPT)
+12 if FMT=2
SET $EXTRACT(RAY,55,60)=$GET(CPT)
+13 if FMT=1
SET $EXTRACT(RAY,60,70)=$GET(RAX)
+14 if FMT=2
SET $EXTRACT(RAY,65,77)=$GET(RAX)
+15 SET ^TMP("RA PROC UPDATE 45",$JOB,SUB)=RAY
+16 QUIT
+17 ;
STOP ;inform the user that the task has been stopped
+1 SET ^TMP("RA PROC UPDATE 45",$JOB,$$SUB())="RA*5*45's Orderable Items-Rad/Nuc Med Proc. synchronization has been terminated prematurely"
+2 QUIT
+3 ;
SUB() ;return the next available subscript (arithmetic progression)
+1 QUIT +$ORDER(^TMP("RA PROC UPDATE 45",$JOB,$CHAR(32)),-1)+1
+2 ;
