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

RACPTMSC.m

Go to the documentation of this file.
  1. RACPTMSC ;HISC/SWM - CPT Mod screen, misc. ;5/30/00 11:02
  1. ;;5.0;Radiology/Nuclear Medicine;**10,19,38**;Mar 16, 1998
  1. Q
  1. SCRN(Y) ;screen entry of cpt mod
  1. ; called from file 70.03's field 135's screen
  1. ; Y = ien of file 81.3
  1. ; RACPT= CPT ien of this exam's procedure
  1. ; RADT = exam date
  1. ; RAX = screen's outcome, 0=failed
  1. N RACPT,RADT,RAX,RA7002,RA7003,RA1,RA2,RA3
  1. S (RA7002,RA7003)=""
  1. D SET
  1. I RA7002="" Q 0
  1. I RA7003="" Q 0
  1. S RADT=$P(RA7002,U) I 'RADT Q 0
  1. S RACPT=+$P(^RAMIS(71,+$P(RA7003,U,2),0),U,9) I 'RACPT Q 0
  1. S RAX=$$MODP^ICPTMOD(RACPT,+Y,"I",RADT) S:RAX<0 RAX=0
  1. Q RAX
  1. SET ; use Rad vars if available
  1. I $D(RADFN),$D(RADTI),$D(RACNI) S RA1=RADFN,RA2=RADTI,RA3=RACNI G SET23
  1. S RA1=$G(D0),RA2=$G(D1),RA3=$G(D2)
  1. Q:((RA1="")!(RA2="")!(RA3=""))
  1. SET23 S RA7002=$G(^RADPT(RA1,"DT",RA2,0)),RA7003=$G(^RADPT(RA1,"DT",RA2,"P",RA3,0))
  1. Q
  1. DW ; del exam's cpt mods and warn of proc mods
  1. ; called from file 70.03's field 2's Mumps xref for kill
  1. ; Y = ien of file 81.3
  1. N RA7002,RA7003,RA1,RA2,RA3,RAX,RAROOT
  1. S (RA7002,RA7003)=""
  1. D SET
  1. Q:RA7002=""
  1. Q:RA7003=""
  1. G:'$O(^RADPT(RA1,"DT",RA2,"P",RA3,"CMOD",0)) WARN
  1. S RAX=0 ;del all cpt modifiers
  1. F S RAX=$O(^RADPT(RA1,"DT",RA2,"P",RA3,"CMOD",RAX)) Q:'RAX D
  1. . S RAROOT(70.3135,RAX_","_RA3_","_RA2_","_RA1_",",.01)="@"
  1. . D FILE^DIE("K","RAROOT")
  1. W !!?5,"All previous CPT Modifier(s) are deleted.",!
  1. WARN Q:'$O(^RADPT(RA1,"DT",RA2,"P",RA3,"M","B",0))
  1. S RAX=0 ;warn of existing proc mods
  1. W !!?5,"Current Procedure Modifier(s) :"
  1. F S RAX=$O(^RADPT(RA1,"DT",RA2,"P",RA3,"M",RAX)) Q:'RAX W !?10,$P($G(^RAMIS(71.2,+^(RAX,0),0)),U)
  1. Q
  1. ACTCODE(RA1,RA2) ;outputs CPT code active status
  1. ; output=1 active, =0 inactive
  1. ; RA1 = CPT CODE, internal or external
  1. ; RA2 = date to check CPT Code
  1. N RA
  1. S RA=$$CPT^ICPTCOD(RA1,RA2)
  1. I $P(RA,"^",7)=1 Q 1
  1. Q 0
  1. NAMCODE(RA1,RA2) ;outputs flds #.01 and #2 of CPT record
  1. ; RA1 = CPT CODE, internal or external
  1. ; RA2 = date to check CPT Code
  1. N RA
  1. S RA=$$CPT^ICPTCOD(RA1,RA2)
  1. S:+RA=-1 RA=""
  1. S RA=$P(RA,"^",2,3)
  1. Q RA
  1. BASICMOD(RA1,RA2) ; outputs basic modifier info
  1. ; RA1 = CPT MODIFIER, internal is used here
  1. ; RA2 = date to check CPT Modifier
  1. Q $$MOD^ICPTMOD(RA1,"I",RA2)
  1. ACTMOD(RA1,RA2) ; outputs active status of CPT modifier
  1. ; RA1 = CPT MODIFIER, internal is used here
  1. ; RA2 = date to check CPT Modifier
  1. ; output:
  1. ; RA3 = 0 is inactive, >0 is active
  1. ; RAMODSTR returned from call to MOD^ICPTMOD
  1. N RA3
  1. S RAMODSTR=$$MOD^ICPTMOD(RA1,"I",RA2)
  1. S RA3=+RAMODSTR
  1. S:RA3<0 RA3=0
  1. S:'$P(RAMODSTR,U,7) RA3=0
  1. Q RA3
  1. SETDEFS ; set default CPT Modifiers, called by [RA REGISTER]
  1. ; 1st choice, defaults from file 71
  1. ; 2nd choice, defaults from file 79.1
  1. N RAROOT
  1. S RAROOT=$S($O(^RAMIS(71,+RAPRI,"DCM",0)):"^RAMIS(71,"_+RAPRI_",""DCM"",",$O(^RA(79.1,+RAMLC,"DCM",0)):"^RA(79.1,"_+RAMLC_",""DCM"",",1:"")
  1. Q:RAROOT=""
  1. N RA1,RA2,RA3,RAFDA,RAIEN,RAMSG
  1. Q:$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"CMOD",0)) ;<--- ???
  1. S RA1=0,RA2=RACNI_","_RADTI_","_RADFN
  1. LOOP1 K RAFDA,RAIEN,RAMSG ;clear arrays each time
  1. S RA1=$O(@(RAROOT_RA1_")")) Q:'RA1
  1. S RA3=+@(RAROOT_RA1_",0)")
  1. ; convert ien to external so Updater will validate data
  1. ; use DT because we're just getting the external value
  1. S RA3=$$BASICMOD(RA3,DT)
  1. G:+RA3<0 LOOP1 ; skip invalid CPT Modifier
  1. G:'$P(RA3,U,7) LOOP1 ; skip inactive CPT Modifier
  1. S RAFDA(70.3135,"+2,"_RA2_",",.01)=$P(RA3,U,2)
  1. D UPDATE^DIE("E","RAFDA","RAIEN","RAMSG")
  1. G:'$D(RAMSG) LOOP1
  1. W !!,$C(7),"** Unable to enter default CPT Modifier ",$P(RA3,U,2)," (",$P($P(RA3,U,3)," "),") **",!
  1. G LOOP1
  1. DISCMOD ; display existing CPT Modifiers
  1. Q:'$D(RADFN) Q:'$D(RADTI) Q:'$D(RACNI)
  1. N RA1,RA2,RA3 S RA1=0
  1. W:$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"CMOD",RA1)) !
  1. LOOP2 S RA1=$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"CMOD",RA1)) Q:'RA1 S RA2=+^(RA1,0)
  1. S RA3=$$BASICMOD(RA2,DT)
  1. S:+RA3<0 RA3=""
  1. ; need parse with " " to rid trailing blanks
  1. W !?6,$P(RA3,"^",2),?9,"(",$P($P(RA3,"^",3)," "),") (",$S($P(RA3,"^",7)=1:"",1:"in"),"active)"
  1. G LOOP2
  1. SDP(Y) ; SCREEN DEFAULT cpt mod for a PROCEDURE
  1. ; called from file 71's field 135's screen
  1. ; Y = ien of file 81.3
  1. ; RACPT= CPT ien of this procedure
  1. ; RAX = screen's outcome, 0=failed
  1. N RACPT,RAX,RA1,RA2,RA3
  1. S RACPT=+$P(^RAMIS(71,+$G(D0),0),U,9) I 'RACPT Q 0
  1. S RAX=$$MODP^ICPTMOD(RACPT,+Y,"I",DT) S:RAX<0 RAX=0
  1. Q RAX
  1. SDL(Y) ; SCREEN DEFAULT cpt mod for a LOCATION
  1. ; called from file 79.1's field 135's screen
  1. ; Y = ien of file 81.3
  1. ; RAX = screen's outcome; 0=failed
  1. N RAX,RAMODSTR
  1. S RAX=$$ACTMOD(Y,DT) S:RAX<0 RAX=0
  1. Q RAX
  1. DISDCM ;display existing Default CPT Modifers for procedure or location
  1. ; file 71 used if called from [RA PROCEDURE EDIT]
  1. ; file 79.1 used if called from [RA LOCATION PARAMETERS]
  1. Q:'($D(DA)#2) Q:'$D(DIE)
  1. N RA1,RA2,RA3 S RA1=0
  1. D:DIE["79.1" WARNLOC
  1. I $O(@(DIE_DA_",""DCM"","_RA1_")")) W !
  1. F S RA1=$O(@(DIE_DA_",""DCM"","_RA1_")")) Q:'RA1 S RA2=+^(RA1,0) S RA3=$$BASICMOD(RA2,DT) S:+RA3<0 RA3="" W !?6,$P(RA3,"^",2),?9,"(",$P($P(RA3,"^",3)," "),")"
  1. Q
  1. EHDP ; EXECUTABLE HELP for DEFAULT CPT MODIFIERS (PROC)
  1. N RATXT
  1. S RATXT(1)=" Choose a CPT Modifier that should be automatically stuffed"
  1. S RATXT(2)=" into the exam record with this procedure, during exam"
  1. S RATXT(3)=" registration."
  1. S RATXT(4)=" "
  1. D EN^DDIOL(.RATXT)
  1. Q
  1. EHDL ; EXECUTABLE HELP for DEFAULT CPT MODIFIERS (LOC)
  1. D WARNLOC
  1. N RATXT
  1. S RATXT(1)=" Choose a CPT Modifier that should be automatically stuffed"
  1. S RATXT(2)=" into the exam record, when the following 2 conditions"
  1. S RATXT(3)=" are both met :"
  1. S RATXT(4)=" 1-There is no default CPT Modifier for this exam's procedure."
  1. S RATXT(5)=" 2-This location is the current sign-on (or switched-to) location"
  1. S RATXT(6)=" at the time of registration."
  1. S RATXT(7)=" If your entry is invalid, then during exam registration, this"
  1. S RATXT(8)=" Default CPT Modifier will NOT be stuffed, instead, an error message"
  1. S RATXT(9)=" with the name of the rejected CPT Modifier would be displayed."
  1. S RATXT(10)=" "
  1. D EN^DDIOL(.RATXT)
  1. Q
  1. WARNLOC N RATXT
  1. S RATXT(1)=" +----------------------------------------------------------------+"
  1. S RATXT(2)=" | Your entry cannot be compared with a CPT CODE, so be very sure |"
  1. S RATXT(3)=" | that this is the Default CPT Modifier that you want to stuff |"
  1. S RATXT(4)=" | into every registered exam from this imaging location. |"
  1. S RATXT(5)=" +----------------------------------------------------------------+"
  1. D EN^DDIOL(.RATXT)
  1. Q