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