- 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 Feb 18, 2025@23:59:38 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 ;