RAUTL4 ;HISC/CAH,FPT,GJC AISC/SAW - Utility Routine ; Jan 05, 2022@16:30:37
;;5.0;Radiology/Nuclear Medicine;**123,186**;Mar 16, 1998;Build 1
;
; Supported IA #1252 reference to $$OUTPTPR^SDUTL3 & $$OUTPTAP^SDUTL3 5-P123
; Supported IA #10035 reference to (^DPT(DFN,.1) 5-P123
;
; 5-P123 6/25/2015 MJT RA*5*123 NSR 20140515 add primary care provider if pt is outpatient
;
EN1 ;ENTRY POINT FOR INPUT TRANSFORM FOR FIELD 5, FILE 74
S RAX=$G(^RARPT(DA,0))
I X="R",$D(^RA(79.1,+$P(^RADPT(+$P(RAX,U,2),"DT",(9999999.9999-$P(RAX,U,3)),0),U,4),0)),$P(^(0),U,17)'["Y" K X W !,"This Imaging Location does not allow the use of 'RELEASED/NOT VERIFIED' status!" G EXIT
G EXIT:X'="V" S RACI=$S($D(RACNI):+RACNI,1:+$O(^RADPT(+$P(RAX,U,2),"DT",9999999.9999-$P(RAX,U,3),"P","B",+$P(RAX,U,4),0)))
I '$D(^RADPT(+$P(RAX,U,2),"DT",9999999.9999-$P(RAX,U,3),"P",RACI,0)) K X W !?3,"Exam information is missing. Unable to continue." G EXIT
S RA0=^RADPT(+$P(RAX,U,2),"DT",9999999.9999-$P(RAX,U,3),"P",RACI,0),RAY=$S($D(^RAMIS(71,+$P(RA0,U,2),0)):$P(^(0),U,7),1:"N")
I RAY'["Y",$D(^VA(200,+$P(RA0,U,12),0)) S RAY=$S($D(^("RA")):$P(^("RA"),U),1:"N")
I RAY["Y",'$D(^VA(200,+$P(RA0,U,15),0)) K X W !?3,"Staff review is required to verify this report!" G EXIT
I '$P(RA0,U,12),'$P(RA0,U,15) K X W !?3,"You must have at least an interpreting 'resident' or 'staff' entered before you can verify this report!" G EXIT
I $D(^RA(79,+$P(^RADPT(+$P(RAX,U,2),"DT",(9999999.9999-$P(RAX,U,3)),0),U,3),.1)),$P(^(.1),U,16)="Y",$O(^RARPT(DA,"I",0))<0 K X W !?3,"An impression was not entered. Verifying is not allowed!"
; Handle the situation where a report moves from no report status
; (null) to a report status of verified. This situation happens at
; sites when creating stub reports through the Imaging software.
I $P(RAX,"^",5)="",(X="V") D
. X:$D(^DD(74,5,1,2,2))#2 ^(2) ; kill 'ARES' xref
. X:$D(^DD(74,5,1,3,2))#2 ^(2) ; kill 'ASTF' xref
. Q
EXIT K RA0,RAX,RAY Q
ASK ;Prompt for range of entries, parse response
;INPUT VARIABLES: ;ch
; RAF1: If defined, a list or range of numbers are permitted i.e,
; 1,2,3-8. If not defined, only single number input is permitted.
; RACNT=highest possible number in range
; ^TMP($J,"RAEX",n)=array of acceptable numeric responses
;OUTPUT VARIABLES:
; RADUP(n)=array of all selected numeric responses
K RADUP S (RAERR,RAI)=0
S X=$$USRSEL($D(RAF1)#2,$G(RACNT)) Q:X="^"!(X="")
; X returns: a single # -OR- a list of #'s i.e, 1-3,8 or 2,3,4 -OR- '^'
I '$D(RAF1),'$D(^TMP($J,"RAEX",+X)) W !!?3,*7,"Item ",+X," is not a valid selection.",! G ASK
I '$D(RAF1) S X=+X,Y=^TMP($J,"RAEX",+X) Q
PARSE ; Parse out the list of numbers entered by the user.
S RAI=RAI+1,RAPAR=$P(X,",",RAI) G EX:RAPAR="" I RAPAR?.N1"-".N S RADASH="" F RASEL=$P(RAPAR,"-"):1:$P(RAPAR,"-",2) D CHK G ASK:RAERR
I '$D(RADASH) S RASEL=RAPAR D CHK
K RADASH G ASK:RAERR,PARSE
;
CHK I $D(RADASH),+$P(RAPAR,"-",2)<+$P(RAPAR,"-") S RAERR=1 W !?3,*7,"Invalid range of numbers specified." Q
I RASEL'?.N!(RASEL'=+RASEL)!(RASEL?16.N.E) D Q
. W !?3,$C(7),"Item ",RASEL," is not a valid selection.",!
. S RAERR=1
. Q
I '$D(^TMP($J,"RAEX",RASEL)) W !?3,*7,"Item ",RASEL," is not a valid selection.",! S RAERR=1 Q
I $D(RADUP(RASEL)) W !?3,*7,"Item ",RASEL," was already selected.",! S RAERR=1 Q
S RADUP(RASEL)="" Q
EX S X="" I 'RAERR,$D(RADUP) S X=1
Q
;
UPPER ;Convert X to uppercase letters, return as Y
S Y=$$UP^XLFSTR(X)
Q
ORDEL ; Inform the 'Rad' user that the 'Order' field is null!
; Called from the [RA STATUS ENTRY] template.
W !!?5,"The value for the 'Order' field has been deleted, this"
W !?5,"Examination Status is now inactive/invalid. Please use"
W !?5,"the 'List Exams with Inactive/Invalid Statuses' option to"
W !?5,"generate a report showing all inactive/invalid exams.",!,$C(7)
Q
EMAIL ; Sent the message off to the req. physician
Q:'$D(DUZ)#2 ; DUZ not defined!
Q:'($D(^TMP($J,"RA AUTOE"))\10) ; no report data, abort
N DUZ,XMDUZ,XMSUB,XMTEXT,XMY S XMDUZ=.5
S XMTEXT="^TMP($J,""RA AUTOE"","
S XMSUB="Rad/Nuc Med Report ("_$P($G(^RARPT(RA74IEN,0)),"^")_")"
; *** NSR 20140515 Start Mod add primary care provider if pt is outpatient 5-P123 ***
; *** Also sends to associate provider if one identified ; 5-P123
S DFN=$P(RA74(0),U,2)
I '$D(^DPT(DFN,.1)) S RAPCP=$$OUTPTPR^SDUTL3(DFN) S:RAPCP'="" XMY($P(RAPCP,U,1))="" S RAAP=$$OUTPTAP^SDUTL3(DFN) S:RAAP'="" XMY($P(RAAP,U,1))="" ; 5-P123
S XMY(RARPHYS)="" D ^XMD K ^TMP($J,"RA AUTOE")
K RAAP,RAPCP ; 5-P123
; *** NSR 20140515 End Mod add primary care provider if pt is outpatient 5-P123 ***
Q
ENV() ; Check the current environment the software is running under.
; If package is being installed DO NOT fire off message (0)
; If package wide variables are missing, DO NOT fire off message (0)
Q:'$D(RACCESS(DUZ))\10!('$D(RAIMGTY))!('$D(RAMDIV))!('$D(RAMDV))!('$D(RAMLC)) 0 ; not in package
Q:$D(XPDNM) 0 ; in environment check OR pre/post install routine
Q 1
INCR(X) ; increment a variable by one
S X=X+1,RAACNT=X
Q RAACNT
;
USRSEL(RABOOL,RACNT) ; Allows the user to select a number or list of
; numbers within a certain range.
; Vars: RABOOL=1 if a list of #'s can be entered i.e, 1-3,8 -or- 2,3,4
; =0 a single number is the only valid input
; RACNT=the upper value within the valid range of numbers
N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
S DIR("A",1)="Type a '^' to STOP, or"
S DIR("A")="CHOOSE FROM 1-"_RACNT_": "
I RABOOL D ; setup DIR to accept a list of #'s within our range
. S DIR(0)="LACO^1:"_RACNT_":0",DIR("?",1)="Please enter a number or range of numbers seperated by a dash,",DIR("?")="or two or more numbers seperated by a combination of commas and dashes."
. Q
E D ; setup DIR to accept a single number within our range
. S DIR(0)="NAO^1:"_RACNT_":0",DIR("?",1)="Enter the number corresponding to the exam you wish to select.",DIR("?")="A list or range of numbers will not be accepted."
. Q
D ^DIR S:$D(DTOUT)!($D(DUOUT)) Y="^" ; exit iff timeout or '^'
; this code effects the selection of exam record data when presented
; to the user from options: 'Profile of Rad/Nuc Med Exams', 'Case
; No. Exam Edit' & 'Select Report to Print by Patient'.
; Called from ^RAPTLU (patient exam lookup)
S:$E(Y,$L(Y))="," Y=$$COMMA(Y)
Q Y
COMMA(Y) ; If the last character in a string is a comma, strip it off
; example: 1-100, becomes 1-100
N RA F RA=$L(Y):-1 Q:$E(Y,RA)'=","
Q $E(Y,1,RA)
;
ASKFILM(RAITYP,RAY3) ;do higher exam statuses have ASK FOR FILM DATA?
;set to 'Y' (YES)? <case sensitive> p186
;Input: RAITYP = imaging type (external)
; RAY3 = 0 node EXAMINATIONS multiple (#70.03)
;
;return: 'X' 0 for don't ask; 1 ask
N RAIEN,RAORD,X,Y S X=0
S (RAORD,Y)=$P($G(^RA(72,+$P(RAY3,U,3),0)),U,3)
;note: RAORD is order # for current status
F S Y=$O(^RA(72,"AA",RAITYP,Y)) Q:Y="" D Q:X=1
.S RAIEN=$O(^RA(72,"AA",RAITYP,Y,0)) ;IEN file 72
.;^DD(72,.24,0)="ASK FOR FILM DATA?^RS^Y:YES;N:NO;^.2;4^Q
.S:$P($G(^RA(72,RAIEN,.2)),U,4)="Y" X=1
.Q
Q X
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRAUTL4 7169 printed Nov 22, 2024@17:50:26 Page 2
RAUTL4 ;HISC/CAH,FPT,GJC AISC/SAW - Utility Routine ; Jan 05, 2022@16:30:37
+1 ;;5.0;Radiology/Nuclear Medicine;**123,186**;Mar 16, 1998;Build 1
+2 ;
+3 ; Supported IA #1252 reference to $$OUTPTPR^SDUTL3 & $$OUTPTAP^SDUTL3 5-P123
+4 ; Supported IA #10035 reference to (^DPT(DFN,.1) 5-P123
+5 ;
+6 ; 5-P123 6/25/2015 MJT RA*5*123 NSR 20140515 add primary care provider if pt is outpatient
+7 ;
EN1 ;ENTRY POINT FOR INPUT TRANSFORM FOR FIELD 5, FILE 74
+1 SET RAX=$GET(^RARPT(DA,0))
+2 IF X="R"
IF $DATA(^RA(79.1,+$PIECE(^RADPT(+$PIECE(RAX,U,2),"DT",(9999999.9999-$PIECE(RAX,U,3)),0),U,4),0))
IF $PIECE(^(0),U,17)'["Y"
KILL X
WRITE !,"This Imaging Location does not allow the use of 'RELEASED/NOT VERIFIED' status!"
GOTO EXIT
+3 if X'="V"
GOTO EXIT
SET RACI=$SELECT($DATA(RACNI):+RACNI,1:+$ORDER(^RADPT(+$PIECE(RAX,U,2),"DT",9999999.9999-$PIECE(RAX,U,3),"P","B",+$PIECE(RAX,U,4),0)))
+4 IF '$DATA(^RADPT(+$PIECE(RAX,U,2),"DT",9999999.9999-$PIECE(RAX,U,3),"P",RACI,0))
KILL X
WRITE !?3,"Exam information is missing. Unable to continue."
GOTO EXIT
+5 SET RA0=^RADPT(+$PIECE(RAX,U,2),"DT",9999999.9999-$PIECE(RAX,U,3),"P",RACI,0)
SET RAY=$SELECT($DATA(^RAMIS(71,+$PIECE(RA0,U,2),0)):$PIECE(^(0),U,7),1:"N")
+6 IF RAY'["Y"
IF $DATA(^VA(200,+$PIECE(RA0,U,12),0))
SET RAY=$SELECT($DATA(^("RA")):$PIECE(^("RA"),U),1:"N")
+7 IF RAY["Y"
IF '$DATA(^VA(200,+$PIECE(RA0,U,15),0))
KILL X
WRITE !?3,"Staff review is required to verify this report!"
GOTO EXIT
+8 IF '$PIECE(RA0,U,12)
IF '$PIECE(RA0,U,15)
KILL X
WRITE !?3,"You must have at least an interpreting 'resident' or 'staff' entered before you can verify this report!"
GOTO EXIT
+9 IF $DATA(^RA(79,+$PIECE(^RADPT(+$PIECE(RAX,U,2),"DT",(9999999.9999-$PIECE(RAX,U,3)),0),U,3),.1))
IF $PIECE(^(.1),U,16)="Y"
IF $ORDER(^RARPT(DA,"I",0))<0
KILL X
WRITE !?3,"An impression was not entered. Verifying is not allowed!"
+10 ; Handle the situation where a report moves from no report status
+11 ; (null) to a report status of verified. This situation happens at
+12 ; sites when creating stub reports through the Imaging software.
+13 IF $PIECE(RAX,"^",5)=""
IF (X="V")
Begin DoDot:1
+14 ; kill 'ARES' xref
if $DATA(^DD(74,5,1,2,2))#2
XECUTE ^(2)
+15 ; kill 'ASTF' xref
if $DATA(^DD(74,5,1,3,2))#2
XECUTE ^(2)
+16 QUIT
End DoDot:1
EXIT KILL RA0,RAX,RAY
QUIT
ASK ;Prompt for range of entries, parse response
+1 ;INPUT VARIABLES: ;ch
+2 ; RAF1: If defined, a list or range of numbers are permitted i.e,
+3 ; 1,2,3-8. If not defined, only single number input is permitted.
+4 ; RACNT=highest possible number in range
+5 ; ^TMP($J,"RAEX",n)=array of acceptable numeric responses
+6 ;OUTPUT VARIABLES:
+7 ; RADUP(n)=array of all selected numeric responses
+8 KILL RADUP
SET (RAERR,RAI)=0
+9 SET X=$$USRSEL($DATA(RAF1)#2,$GET(RACNT))
if X="^"!(X="")
QUIT
+10 ; X returns: a single # -OR- a list of #'s i.e, 1-3,8 or 2,3,4 -OR- '^'
+11 IF '$DATA(RAF1)
IF '$DATA(^TMP($JOB,"RAEX",+X))
WRITE !!?3,*7,"Item ",+X," is not a valid selection.",!
GOTO ASK
+12 IF '$DATA(RAF1)
SET X=+X
SET Y=^TMP($JOB,"RAEX",+X)
QUIT
PARSE ; Parse out the list of numbers entered by the user.
+1 SET RAI=RAI+1
SET RAPAR=$PIECE(X,",",RAI)
if RAPAR=""
GOTO EX
IF RAPAR?.N1"-".N
SET RADASH=""
FOR RASEL=$PIECE(RAPAR,"-"):1:$PIECE(RAPAR,"-",2)
DO CHK
if RAERR
GOTO ASK
+2 IF '$DATA(RADASH)
SET RASEL=RAPAR
DO CHK
+3 KILL RADASH
if RAERR
GOTO ASK
GOTO PARSE
+4 ;
CHK IF $DATA(RADASH)
IF +$PIECE(RAPAR,"-",2)<+$PIECE(RAPAR,"-")
SET RAERR=1
WRITE !?3,*7,"Invalid range of numbers specified."
QUIT
+1 IF RASEL'?.N!(RASEL'=+RASEL)!(RASEL?16.N.E)
Begin DoDot:1
+2 WRITE !?3,$CHAR(7),"Item ",RASEL," is not a valid selection.",!
+3 SET RAERR=1
+4 QUIT
End DoDot:1
QUIT
+5 IF '$DATA(^TMP($JOB,"RAEX",RASEL))
WRITE !?3,*7,"Item ",RASEL," is not a valid selection.",!
SET RAERR=1
QUIT
+6 IF $DATA(RADUP(RASEL))
WRITE !?3,*7,"Item ",RASEL," was already selected.",!
SET RAERR=1
QUIT
+7 SET RADUP(RASEL)=""
QUIT
EX SET X=""
IF 'RAERR
IF $DATA(RADUP)
SET X=1
+1 QUIT
+2 ;
UPPER ;Convert X to uppercase letters, return as Y
+1 SET Y=$$UP^XLFSTR(X)
+2 QUIT
ORDEL ; Inform the 'Rad' user that the 'Order' field is null!
+1 ; Called from the [RA STATUS ENTRY] template.
+2 WRITE !!?5,"The value for the 'Order' field has been deleted, this"
+3 WRITE !?5,"Examination Status is now inactive/invalid. Please use"
+4 WRITE !?5,"the 'List Exams with Inactive/Invalid Statuses' option to"
+5 WRITE !?5,"generate a report showing all inactive/invalid exams.",!,$CHAR(7)
+6 QUIT
EMAIL ; Sent the message off to the req. physician
+1 ; DUZ not defined!
if '$DATA(DUZ)#2
QUIT
+2 ; no report data, abort
if '($DATA(^TMP($JOB,"RA AUTOE"))\10)
QUIT
+3 NEW DUZ,XMDUZ,XMSUB,XMTEXT,XMY
SET XMDUZ=.5
+4 SET XMTEXT="^TMP($J,""RA AUTOE"","
+5 SET XMSUB="Rad/Nuc Med Report ("_$PIECE($GET(^RARPT(RA74IEN,0)),"^")_")"
+6 ; *** NSR 20140515 Start Mod add primary care provider if pt is outpatient 5-P123 ***
+7 ; *** Also sends to associate provider if one identified ; 5-P123
+8 SET DFN=$PIECE(RA74(0),U,2)
+9 ; 5-P123
IF '$DATA(^DPT(DFN,.1))
SET RAPCP=$$OUTPTPR^SDUTL3(DFN)
if RAPCP'=""
SET XMY($PIECE(RAPCP,U,1))=""
SET RAAP=$$OUTPTAP^SDUTL3(DFN)
if RAAP'=""
SET XMY($PIECE(RAAP,U,1))=""
+10 SET XMY(RARPHYS)=""
DO ^XMD
KILL ^TMP($JOB,"RA AUTOE")
+11 ; 5-P123
KILL RAAP,RAPCP
+12 ; *** NSR 20140515 End Mod add primary care provider if pt is outpatient 5-P123 ***
+13 QUIT
ENV() ; Check the current environment the software is running under.
+1 ; If package is being installed DO NOT fire off message (0)
+2 ; If package wide variables are missing, DO NOT fire off message (0)
+3 ; not in package
if '$DATA(RACCESS(DUZ))\10!('$DATA(RAIMGTY))!('$DATA(RAMDIV))!('$DATA(RAMDV))!('$DATA(RAMLC))
QUIT 0
+4 ; in environment check OR pre/post install routine
if $DATA(XPDNM)
QUIT 0
+5 QUIT 1
INCR(X) ; increment a variable by one
+1 SET X=X+1
SET RAACNT=X
+2 QUIT RAACNT
+3 ;
USRSEL(RABOOL,RACNT) ; Allows the user to select a number or list of
+1 ; numbers within a certain range.
+2 ; Vars: RABOOL=1 if a list of #'s can be entered i.e, 1-3,8 -or- 2,3,4
+3 ; =0 a single number is the only valid input
+4 ; RACNT=the upper value within the valid range of numbers
+5 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
+6 SET DIR("A",1)="Type a '^' to STOP, or"
+7 SET DIR("A")="CHOOSE FROM 1-"_RACNT_": "
+8 ; setup DIR to accept a list of #'s within our range
IF RABOOL
Begin DoDot:1
+9 SET DIR(0)="LACO^1:"_RACNT_":0"
SET DIR("?",1)="Please enter a number or range of numbers seperated by a dash,"
SET DIR("?")="or two or more numbers seperated by a combination of commas and dashes."
+10 QUIT
End DoDot:1
+11 ; setup DIR to accept a single number within our range
IF '$TEST
Begin DoDot:1
+12 SET DIR(0)="NAO^1:"_RACNT_":0"
SET DIR("?",1)="Enter the number corresponding to the exam you wish to select."
SET DIR("?")="A list or range of numbers will not be accepted."
+13 QUIT
End DoDot:1
+14 ; exit iff timeout or '^'
DO ^DIR
if $DATA(DTOUT)!($DATA(DUOUT))
SET Y="^"
+15 ; this code effects the selection of exam record data when presented
+16 ; to the user from options: 'Profile of Rad/Nuc Med Exams', 'Case
+17 ; No. Exam Edit' & 'Select Report to Print by Patient'.
+18 ; Called from ^RAPTLU (patient exam lookup)
+19 if $EXTRACT(Y,$LENGTH(Y))=","
SET Y=$$COMMA(Y)
+20 QUIT Y
COMMA(Y) ; If the last character in a string is a comma, strip it off
+1 ; example: 1-100, becomes 1-100
+2 NEW RA
FOR RA=$LENGTH(Y):-1
if $EXTRACT(Y,RA)'=","
QUIT
+3 QUIT $EXTRACT(Y,1,RA)
+4 ;
ASKFILM(RAITYP,RAY3) ;do higher exam statuses have ASK FOR FILM DATA?
+1 ;set to 'Y' (YES)? <case sensitive> p186
+2 ;Input: RAITYP = imaging type (external)
+3 ; RAY3 = 0 node EXAMINATIONS multiple (#70.03)
+4 ;
+5 ;return: 'X' 0 for don't ask; 1 ask
+6 NEW RAIEN,RAORD,X,Y
SET X=0
+7 SET (RAORD,Y)=$PIECE($GET(^RA(72,+$PIECE(RAY3,U,3),0)),U,3)
+8 ;note: RAORD is order # for current status
+9 FOR
SET Y=$ORDER(^RA(72,"AA",RAITYP,Y))
if Y=""
QUIT
Begin DoDot:1
+10 ;IEN file 72
SET RAIEN=$ORDER(^RA(72,"AA",RAITYP,Y,0))
+11 ;^DD(72,.24,0)="ASK FOR FILM DATA?^RS^Y:YES;N:NO;^.2;4^Q
+12 if $PIECE($GET(^RA(72,RAIEN,.2)),U,4)="Y"
SET X=1
+13 QUIT
End DoDot:1
if X=1
QUIT
+14 QUIT X
+15 ;
