RANPROU ;BPFO/CLT - NEW RADIOLOGY PROCEDURES UTILITIES ;22 Mar 2018 10:24 AM
;;5.0;Radiology/Nuclear Medicine;**127,124**;Mar 16, 1998;Build 4
;
CPT(DA,RAX) ;Ask for CPT Code when the 'Procedure Enter/Edit' option
;is exercised. Called from input template: W RADIOLOGY PROCEDURE
;Input: DA=ien of new record being edited & RAX=procedure name
N DIR,DIROUT,DIRUT,DTOUT,DUOUT,RAFDA,RAYN,X,Y S RAYN=0
F D Q:+RAYN!($D(DIRUT)#2)
.K X,Y S DIR(0)="71.11,9" D ^DIR Q:$D(DIRUT)#2
.;Y=N^S where N=record ien & S=.01 value of the record
.W !!,"Note: If an erroneous CPT Code is accepted it cannot be changed; the",!,"procedure must be inactivated."
. I $G(RA7111DA)="" S RA7111DA=$G(^TMP("RA7111DA",$J))
. S RAX=$P($G(^RAMRPF(71.11,RA7111DA,0)),U,1) W !!,"Are you adding '"_$P(Y,U,2)_"' as the CPT Code for the new Rad/Nuc Med Procedure",!,"'"_RAX_"'? NO// "
.;S RAX=$P($G(^RAMRPF(71.11,1,0)),U,1) W !!,"Are you adding '"_$P(Y,U,2)_"' as the CPT Code for the new Rad/Nuc Med Procedure",!,"'"_RAX_"'? NO// "
.R RAYN:DTIME
.I '$T!(RAYN["^") S RAYN=-1 Q
.S RAYN=$E(RAYN) S:RAYN="" RAYN="N"
.I "YyNn"'[RAYN 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."
.I W !?5,"Note: If an erroneous CPT Code is accepted it cannot be changed; the",!?5,"procedure must be inactivated."
.S:"Yy"[RAYN RAYN="1^Y"
.S:"Nn"[RAYN RAYN=0
.Q
I $P(RAYN,U,2)="Y" S RAFDA(71.11,DA_",",9)=$P(Y,U) D FILE^DIE("","RAFDA")
Q
;
CHKSTAT() ;Check the status of the study. If the
; exam status of the study is complete bypass the
; editing of the PROCEDURE (70.03 ; 2) field. This
; function is called from [RA EXAM EDIT] grzeis P124
;
; Variables
; ---------
; Input : none
; Return: -1 if missing exam status,
; 0 if exam COMPLETE, else 1.
;
; The following variables must exist: RAY (0 node 70.03) &
; the RA0 array RA0(1...18) where the subscript indicates
; the piece of the parsed zero node: Ex: RA0(3) = EXAM STATUS pointer
; RAX(3) is the ORDER value of the record in file 72.
;
I RA0(3)="" W !?3,"MISSING EXAM STATUS, EXIT CASE EDIT!",! Q -1
N RAX S RAX=$G(^RA(72,RA0(3),0)),RAX(3)=$P(RAX,U,3)
Q $S(RAX(3)=9:0,1:1)
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRANPROU 2249 printed Sep 23, 2025@20:13:43 Page 2
RANPROU ;BPFO/CLT - NEW RADIOLOGY PROCEDURES UTILITIES ;22 Mar 2018 10:24 AM
+1 ;;5.0;Radiology/Nuclear Medicine;**127,124**;Mar 16, 1998;Build 4
+2 ;
CPT(DA,RAX) ;Ask for CPT Code when the 'Procedure Enter/Edit' option
+1 ;is exercised. Called from input template: W RADIOLOGY PROCEDURE
+2 ;Input: DA=ien of new record being edited & RAX=procedure name
+3 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,RAFDA,RAYN,X,Y
SET RAYN=0
+4 FOR
Begin DoDot:1
+5 KILL X,Y
SET DIR(0)="71.11,9"
DO ^DIR
if $DATA(DIRUT)#2
QUIT
+6 ;Y=N^S where N=record ien & S=.01 value of the record
+7 WRITE !!,"Note: If an erroneous CPT Code is accepted it cannot be changed; the",!,"procedure must be inactivated."
+8 IF $GET(RA7111DA)=""
SET RA7111DA=$GET(^TMP("RA7111DA",$JOB))
+9 SET RAX=$PIECE($GET(^RAMRPF(71.11,RA7111DA,0)),U,1)
WRITE !!,"Are you adding '"_$PIECE(Y,U,2)_"' as the CPT Code for the new Rad/Nuc Med Procedure",!,"'"_RAX_"'? NO// "
+10 ;S RAX=$P($G(^RAMRPF(71.11,1,0)),U,1) W !!,"Are you adding '"_$P(Y,U,2)_"' as the CPT Code for the new Rad/Nuc Med Procedure",!,"'"_RAX_"'? NO// "
+11 READ RAYN:DTIME
+12 IF '$TEST!(RAYN["^")
SET RAYN=-1
QUIT
+13 SET RAYN=$EXTRACT(RAYN)
if RAYN=""
SET RAYN="N"
+14 IF "YyNn"'[RAYN
WRITE !?3,"Enter 'Y' to accept the CPT Code, or 'N' to reject the CPT Code or '^' to",!?3,"exit without selecting a CPT Code."
+15 IF $TEST
WRITE !?5,"Note: If an erroneous CPT Code is accepted it cannot be changed; the",!?5,"procedure must be inactivated."
+16 if "Yy"[RAYN
SET RAYN="1^Y"
+17 if "Nn"[RAYN
SET RAYN=0
+18 QUIT
End DoDot:1
if +RAYN!($DATA(DIRUT)#2)
QUIT
+19 IF $PIECE(RAYN,U,2)="Y"
SET RAFDA(71.11,DA_",",9)=$PIECE(Y,U)
DO FILE^DIE("","RAFDA")
+20 QUIT
+21 ;
CHKSTAT() ;Check the status of the study. If the
+1 ; exam status of the study is complete bypass the
+2 ; editing of the PROCEDURE (70.03 ; 2) field. This
+3 ; function is called from [RA EXAM EDIT] grzeis P124
+4 ;
+5 ; Variables
+6 ; ---------
+7 ; Input : none
+8 ; Return: -1 if missing exam status,
+9 ; 0 if exam COMPLETE, else 1.
+10 ;
+11 ; The following variables must exist: RAY (0 node 70.03) &
+12 ; the RA0 array RA0(1...18) where the subscript indicates
+13 ; the piece of the parsed zero node: Ex: RA0(3) = EXAM STATUS pointer
+14 ; RAX(3) is the ORDER value of the record in file 72.
+15 ;
+16 IF RA0(3)=""
WRITE !?3,"MISSING EXAM STATUS, EXIT CASE EDIT!",!
QUIT -1
+17 NEW RAX
SET RAX=$GET(^RA(72,RA0(3),0))
SET RAX(3)=$PIECE(RAX,U,3)
+18 QUIT $SELECT(RAX(3)=9:0,1:1)
+19 ;
