| [613] | 1 | RACOMDEL ;HIRMFO/GJC-Utility, remove duplicates in ^RAMIS(71.3 ;7/10/97 09:17
|
|---|
| 2 | VERSION ;;5.0;Radiology/Nuclear Medicine;;Mar 16, 1998
|
|---|
| 3 | ;
|
|---|
| 4 | ; This routine is called from the RAO7MFN routine after initial
|
|---|
| 5 | ; population of CPRS (OE/RR v3) Orderable Items file.
|
|---|
| 6 | ; Deletes all but one instance of a procedure in the Rad/Nuc Med
|
|---|
| 7 | ; Common Procedure file.
|
|---|
| 8 | K RA1,RA2,RA3,RACNT,RAIEN,RAPROC,^TMP($J,"RA CMMN PROC") S RAPROC=0
|
|---|
| 9 | F S RAPROC=$O(^RAMIS(71.3,"B",RAPROC)) Q:RAPROC'>0 D
|
|---|
| 10 | . S (RACNT,RAIEN)=0
|
|---|
| 11 | . F S RAIEN=+$O(^RAMIS(71.3,"B",RAPROC,RAIEN)) Q:RAIEN'>0 D
|
|---|
| 12 | .. S RACNT=RACNT+1 D:RACNT>1 SAVE
|
|---|
| 13 | .. Q
|
|---|
| 14 | . Q
|
|---|
| 15 | I '$D(^TMP($J,"RA CMMN PROC")) D XIT Q
|
|---|
| 16 | S RA1=0
|
|---|
| 17 | F S RA1=$O(^TMP($J,"RA CMMN PROC",RA1)) Q:RA1'>0 D ;file 71 ien
|
|---|
| 18 | . S RA2="",RACNT=0
|
|---|
| 19 | . F S RA2=$O(^TMP($J,"RA CMMN PROC",RA1,RA2)) Q:RA2']"" D ;active?
|
|---|
| 20 | .. S RA3=0
|
|---|
| 21 | .. F S RA3=$O(^TMP($J,"RA CMMN PROC",RA1,RA2,RA3)) Q:RA3'>0 D ;71.3
|
|---|
| 22 | ... S RACNT=RACNT+1 D:RACNT>1 PURGE(RA3)
|
|---|
| 23 | ... Q
|
|---|
| 24 | .. Q
|
|---|
| 25 | . Q
|
|---|
| 26 | D RESEQ ; re-sequence common procedures
|
|---|
| 27 | XIT ; Kill variables and quit
|
|---|
| 28 | K RA1,RA2,RA3,RACNT,RAIEN,RAPROC,^TMP($J,"RA CMMN PROC")
|
|---|
| 29 | Q
|
|---|
| 30 | PURGE(DA) ; Delete duplicate common procedures saving the first
|
|---|
| 31 | ; occurrence of our common in question. Data is stored so that active
|
|---|
| 32 | ; common procedures will sort first.
|
|---|
| 33 | ; Input: DA-ien of entry in 71.3 to be deleted!
|
|---|
| 34 | K %,DIC,DIK,X,Y S DIK="^RAMIS(71.3," D ^DIK K %,DIC,DIK,X,Y
|
|---|
| 35 | Q
|
|---|
| 36 | SAVE ; Save off all common procedure data when more than one occurrence.
|
|---|
| 37 | K RA713,RACTIV
|
|---|
| 38 | I RACNT=2 D
|
|---|
| 39 | . N RAIEN S RAIEN=+$O(^RAMIS(71.3,"B",RAPROC,0)) Q:'RAIEN
|
|---|
| 40 | . S RA713=$G(^RAMIS(71.3,RAIEN,0)) Q:RA713']""
|
|---|
| 41 | . S RACTIV=$S($P(RA713,"^",5)]"":1,1:0)
|
|---|
| 42 | . D SET
|
|---|
| 43 | . Q
|
|---|
| 44 | S RA713=$G(^RAMIS(71.3,RAIEN,0)) Q:RA713']""
|
|---|
| 45 | S RACTIV=$S($P(RA713,"^",5)]"":1,1:0) D SET
|
|---|
| 46 | K RA713,RACTIV
|
|---|
| 47 | Q
|
|---|
| 48 | SET ; Set the ^TMP($J,"RA CMMN PROC") global.
|
|---|
| 49 | ; RAPROC=pntr to file 71, RAIEN=ien in file 71.3
|
|---|
| 50 | ; RACTIV=Active flag: 1 for inactive, 0 for active
|
|---|
| 51 | S ^TMP($J,"RA CMMN PROC",RAPROC,RACTIV,RAIEN)=""
|
|---|
| 52 | Q
|
|---|
| 53 | RESEQ ;Resequence the common procedure list for all imaging types
|
|---|
| 54 | N D,DA,D0,DI,DIC,DIE,DQ,DR,RACNT,RAI,RAIMGTYI,RAJ,X,Y
|
|---|
| 55 | S DIE="^RAMIS(71.3,",RAIMGTYI=0
|
|---|
| 56 | F S RAIMGTYI=$O(^RAMIS(71.3,"AA",RAIMGTYI)) Q:RAIMGTYI'>0 D
|
|---|
| 57 | . S (RAI,RACNT)=0
|
|---|
| 58 | . F S RAI=$O(^RAMIS(71.3,"AA",RAIMGTYI,RAI)) Q:RAI'>0 D
|
|---|
| 59 | .. S RAJ=0
|
|---|
| 60 | .. F S RAJ=$O(^RAMIS(71.3,"AA",RAIMGTYI,RAI,RAJ)) Q:RAJ'>0 I $D(^RAMIS(71.3,RAJ,0)) D
|
|---|
| 61 | ... S DA=RAJ,RACNT=RACNT+1
|
|---|
| 62 | ... S DR="3////^S X=RACNT" D ^DIE
|
|---|
| 63 | ... Q
|
|---|
| 64 | .. Q
|
|---|
| 65 | . Q
|
|---|
| 66 | Q
|
|---|
