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

RACOMDEL.m

Go to the documentation of this file.
  1. RACOMDEL ;HIRMFO/GJC-Utility, remove duplicates in ^RAMIS(71.3 ;7/10/97 09:17
  1. VERSION ;;5.0;Radiology/Nuclear Medicine;;Mar 16, 1998
  1. ;
  1. ; This routine is called from the RAO7MFN routine after initial
  1. ; population of CPRS (OE/RR v3) Orderable Items file.
  1. ; Deletes all but one instance of a procedure in the Rad/Nuc Med
  1. ; Common Procedure file.
  1. K RA1,RA2,RA3,RACNT,RAIEN,RAPROC,^TMP($J,"RA CMMN PROC") S RAPROC=0
  1. F S RAPROC=$O(^RAMIS(71.3,"B",RAPROC)) Q:RAPROC'>0 D
  1. . S (RACNT,RAIEN)=0
  1. . F S RAIEN=+$O(^RAMIS(71.3,"B",RAPROC,RAIEN)) Q:RAIEN'>0 D
  1. .. S RACNT=RACNT+1 D:RACNT>1 SAVE
  1. .. Q
  1. . Q
  1. I '$D(^TMP($J,"RA CMMN PROC")) D XIT Q
  1. S RA1=0
  1. F S RA1=$O(^TMP($J,"RA CMMN PROC",RA1)) Q:RA1'>0 D ;file 71 ien
  1. . S RA2="",RACNT=0
  1. . F S RA2=$O(^TMP($J,"RA CMMN PROC",RA1,RA2)) Q:RA2']"" D ;active?
  1. .. S RA3=0
  1. .. F S RA3=$O(^TMP($J,"RA CMMN PROC",RA1,RA2,RA3)) Q:RA3'>0 D ;71.3
  1. ... S RACNT=RACNT+1 D:RACNT>1 PURGE(RA3)
  1. ... Q
  1. .. Q
  1. . Q
  1. D RESEQ ; re-sequence common procedures
  1. XIT ; Kill variables and quit
  1. K RA1,RA2,RA3,RACNT,RAIEN,RAPROC,^TMP($J,"RA CMMN PROC")
  1. Q
  1. PURGE(DA) ; Delete duplicate common procedures saving the first
  1. ; occurrence of our common in question. Data is stored so that active
  1. ; common procedures will sort first.
  1. ; Input: DA-ien of entry in 71.3 to be deleted!
  1. K %,DIC,DIK,X,Y S DIK="^RAMIS(71.3," D ^DIK K %,DIC,DIK,X,Y
  1. Q
  1. SAVE ; Save off all common procedure data when more than one occurrence.
  1. K RA713,RACTIV
  1. I RACNT=2 D
  1. . N RAIEN S RAIEN=+$O(^RAMIS(71.3,"B",RAPROC,0)) Q:'RAIEN
  1. . S RA713=$G(^RAMIS(71.3,RAIEN,0)) Q:RA713']""
  1. . S RACTIV=$S($P(RA713,"^",5)]"":1,1:0)
  1. . D SET
  1. . Q
  1. S RA713=$G(^RAMIS(71.3,RAIEN,0)) Q:RA713']""
  1. S RACTIV=$S($P(RA713,"^",5)]"":1,1:0) D SET
  1. K RA713,RACTIV
  1. Q
  1. SET ; Set the ^TMP($J,"RA CMMN PROC") global.
  1. ; RAPROC=pntr to file 71, RAIEN=ien in file 71.3
  1. ; RACTIV=Active flag: 1 for inactive, 0 for active
  1. S ^TMP($J,"RA CMMN PROC",RAPROC,RACTIV,RAIEN)=""
  1. Q
  1. RESEQ ;Resequence the common procedure list for all imaging types
  1. N D,DA,D0,DI,DIC,DIE,DQ,DR,RACNT,RAI,RAIMGTYI,RAJ,X,Y
  1. S DIE="^RAMIS(71.3,",RAIMGTYI=0
  1. F S RAIMGTYI=$O(^RAMIS(71.3,"AA",RAIMGTYI)) Q:RAIMGTYI'>0 D
  1. . S (RAI,RACNT)=0
  1. . F S RAI=$O(^RAMIS(71.3,"AA",RAIMGTYI,RAI)) Q:RAI'>0 D
  1. .. S RAJ=0
  1. .. F S RAJ=$O(^RAMIS(71.3,"AA",RAIMGTYI,RAI,RAJ)) Q:RAJ'>0 I $D(^RAMIS(71.3,RAJ,0)) D
  1. ... S DA=RAJ,RACNT=RACNT+1
  1. ... S DR="3////^S X=RACNT" D ^DIE
  1. ... Q
  1. .. Q
  1. . Q
  1. Q