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

RAUTL23.m

Go to the documentation of this file. 
  1. RAUTL23 ;MANTECH/CLT - LOINC FOR THE HL7 UTILITY ; 28 Oct 2016  11:13 AM
  1.  ;;5.0;Radiology/Nuclear Medicine;**127**;Mar 16, 1998;Build 119
  1. EN ;MAIN ENTRY POINT
  1.  S RAMATCH=$P($G(^RAMIS(71,+$P(RACN0,"^",2),"NTRT")),U,1)
  1.  I $G(RAMATCH)'="" S RALOINC=$P($G(^RAMRPF(71.99,RAMATCH,0)),U,4)
  1.  Q
  1. MTCH ;ALREADY MATCHED NOTIFICATION
  1.  S RAPLUSY=^XTMP("RAMAIN4",$J,Y)
  1. MTCH1 ;ALTERNATE ENTRY POINT
  1.  S RAIEN="",RAIEN=$O(^RAMIS(71,"MRPF",RAPLUSY,RAIEN))
  1.  Q:$G(RAMATCH)="GO"
  1.  W !!?3,$C(7),"The MRPF procedure "_RAMATCH_" is already mapped to your procedure ",$P(^RAMIS(71,RAIEN,0),U,1)_"."
  1.  I RAMTCH=1 W !,"  Use the already created procedure.",!
  1.  ;I RAMTCH=2 W !?3,"Either change "_$P(^RAMIS(71,RAIEN,0),U,1)_" or choose another MRPF.",!
  1.  I $G(RANEW)=1 W !!,"This new procedure will be removed." H 1
  1.  S ^XTMP("RAMAIN4",$J,"RAEND")=1 K RAMTCH
  1.  Q
  1. SEED ;HAS FILE 71.99 BEEN SEEDED
  1.  W !!?3,"The populating of the MASTER RADIOLOGY PROCEDURE file is called seeding.",!
  1.  S DIE="^RAMRPF(71.98,",DA=1,DR="9//NO" D ^DIE
  1.  Q
  1. ONE ;EDIT MAPPING ON A SINGLE PROCEDURE
  1.  N A,RACPTMR,RAPRDA,DA,DR,DIR,DIE,DIC,OK,RAPRNM,RAMRPFNM,RAMRPFDA,RAXX
  1.  S (A,RACPTMR)=""
  1.  S DIC="^RAMIS(71,",DIC(0)="AEQM",DIC("A")="ENTER THE PROCEDURE TO BE EDITED:"
  1.  D ^DIC I +Y'>0 G ONEQT
  1.  S DA=+Y,(A,RACPTMR,RAPRDA)="",RAPRDA=DA,RAPRNM=$$GET1^DIQ(71,DA_",",.01)
  1.  ; inactive check
  1.  S A=$$GET1^DIQ(71,DA_",",100,"I") I A'="" W !!,"This procedure is inactive" D ONEQT G ONE
  1.  ; check for CPT code
  1.  S RACPTMR=$$GET1^DIQ(71,DA_",",9,"E") I RACPTMR="" W !!,"This procedure is not associated to a CPT Code." D ONEQT G ONE
  1.  ; check if associated to MRPF
  1.  S A=$$GET1^DIQ(71,DA_",",900,"I") I A'="" S RAXX=$$GET1^DIQ(71.99,A_",",.01) W !!,"This procedure is already mapped to "_RAXX_"." D ONEQT G ONE
  1.  ; CPT code not in MRPF
  1.  S A=$O(^RAMRPF(71.99,"C",RACPTMR,0)) I 'A W !!,"There are not any MRPF entries associated to CPT Code: "_RACPTMR D ONEQT G ONE
  1.  ; check if all affiliated MRPFs are in use
  1.  S A=0,OK=0 F  S A=$O(^RAMRPF(71.99,"C",RACPTMR,A)) Q:'A  D  I OK=1 Q
  1.  . S B=$O(^RAMIS(71,"MRPF",A,""))
  1.  . I B'="" Q
  1.  . S OK=1 Q
  1.  I 'OK W !!,"All MRPF Terms for this CPT Code ("_RACPTMR_") are allocated to other Procedures" D ONEQT G ONE
  1.  ; select MRPF for procedure
  1.  K DIR,DIRUT,DA,Y
  1.  S DIR("S")="I '$$SCREEN^XTID(71.99,"""",(+Y_"",""))&($$ONECHK^RAUTL23(+Y)=1)&($$ONECK2^RAUTL23(+Y)=1)"
  1.  S DIR(0)="PO^71.99:EQZ"
  1.  S DIR("A")="Enter the MRPF to Associate with the Selected Procedure"
  1.  S DIR("?")="Enter the MRPF that you want to associate to the Procedure. Or, enter a '?' to view available choices for the Procedures CPT"
  1.  D ^DIR ; I $D(DIRUT) G ONEQT
  1.  I Y="^"!(X="^") G ONEQT
  1.  I +Y'>0 W !,"Nothing Selected" D ONEQT G ONE
  1.  N DA,DIE,DR
  1.  S A=$G(^RAMRPF(71.99,+Y,0)),A=$P(A,"^",4),RAMRPFDA=+Y
  1.  S DA=RAPRDA,DIE="^RAMIS(71,",DR="900///"_RAMRPFDA_";903///"_A D ^DIE
  1.  S RAMRPFNM=$$GET1^DIQ(71.99,RAMRPFDA_",",.01)
  1.  K DA,DIE,DR
  1.  W !!,"Procedure "_RAPRNM_" is now associated to MRPF "_RAMRPFNM
  1.  W !! D ONEQT G ONE
  1.  Q
  1.  ;
  1. ONEQT ; quit from one
  1.  K A,RACPTMR,RAPRDA,DA,DR,DIR,DIE,DIC,OK,RAPRNM,RAMRPFNM,RAMRPFDA,RAXX
  1.  Q
  1.  ;
  1. ONECHK(A) ; check if MRPF has same CPT code
  1.  I 'A Q 0
  1.  N B S B=$G(^RAMRPF(71.99,A,0)),B=$P(B,"^",3)
  1.  I B'=RACPTMR K B Q 0
  1.  K B Q 1
  1.  ;
  1. ONECK2(A) ; check if other 71 procedure is using MRPF item
  1.  I 'A Q 0
  1.  N B S B=""
  1.  S B=$O(^RAMIS(71,"MRPF",A,B))
  1.  I B K B Q 0
  1.  K B Q 1
  1.  ;
  1. LOINC ;ENTER/EDIT LOINC FOR ONE ENTRY IN FILE 71
  1.  N DIC,DIE,X,Y
  1.  S DIC="^RAMIS(71,",DIC(0)="AEQM" D ^DIC Q:Y'>0  S DA=+Y
  1.  S DIE=DIC,DR=903 D ^DIE
  1.  Q
  1. ACTIVE ;IS THE MRPF ENTRY ACTIVE
  1.  N RA99,I99,I999 S I99=0 F  S I99=$O(^RAMRPF(71.99,RAPROIEN,"TERMSTATUS","B",I99)) Q:I99=""  D
  1.  . S I999="",I999=$O(^RAMRPF(71.99,RAPROIEN,"TERMSTATUS","B",I99,I999))
  1.  . I $P(^RAMRPF(71.99,RAPROIEN,"TERMSTATUS",I999,0),U,1)<DT S RA99=$S($P(^(0),U,2)=1:"ACTIVE",1:"INACTIVE")
  1.  . Q
  1.  Q $G(RA99)
  1. CPT(DA,RAX) ;Ask for CPT Code when the 'Procedure Enter/Edit' option
  1.  ;is exercised. Called from input template: RA PROCEDURE EDIT
  1.  ;Input: DA=ien of new record being edited & RAX=procedure name
  1.  N DIR,DIROUT,DIRUT,DTOUT,DUOUT,RAFDA,RAYN,X,Y S RAYN=0
  1.  F  D  Q:+RAYN!($D(DIRUT)#2)
  1.  .K X,Y S DIR(0)="71,9" D ^DIR Q:$D(DIRUT)#2
  1.  .;Y=N^S where N=record ien & S=.01 value of the record
  1.  .W !!,"Note: If an erroneous CPT Code is accepted it cannot be changed; the",!,"procedure must be inactivated."
  1.  .W !!,"Are you adding '"_$P(Y,U,2)_"' as the CPT Code for the new Rad/Nuc Med Procedure",!,"'"_RAX_"'? NO// "
  1.  . S DIR(0)="Y",DIR("B")="NO",DIR("A",1)="Are you adding '"_+Y_"' as the CPT Code for the new RAD/NUC MED PROCEDURE",DIR("A")=RAX D ^DIR
  1.  . D ^DIR
  1.  .;R RAYN:DTIME
  1.  .;I '$T!(RAYN["^") S RAYN=-1 Q
  1.  .;S RAYN=$E(RAYN) S:RAYN="" RAYN="N"
  1.  .I "YyNn"'[X W !?3,"Enter 'Y' to accept the CPT Code, or 'N' to reject the CPT Code or '^' to",!?3,"exit without selecting a CPT Code."
  1.  .I  W !?5,"Note: If an erroneous CPT Code is accepted it cannot be changed; the",!?5,"procedure must be inactivated."
  1.  .S:"Yy"[X RAYN="1^Y"
  1.  .S:"Nn"[X RAYN=0
  1.  .Q
  1.  I $P(RAYN,U,2)="Y" S RAFDA(71,DA_",",9)=$P(Y,U) D FILE^DIE("","RAFDA")
  1.  Q