RABWRTE ;HISC/SM - Billing Aware Report Entry ;11/19/04 12:35
;;5.0;Radiology/Nuclear Medicine;**41**;Mar 16,1998
Q
ELOC ;Enter Inter. Img. Location
; called from IN1^RARTE4 & NOEDIT^RARTRPV1
N RACLC0,RADT0,RAERR,RAXITYPI,RAXITYPE,RAIIL
; RACLC0 = current switchedTo/signedOn loc's 0 node
; RADT0 = exam's DT 0 node
; RAXITYP = exam's Imaging Type in text
; RAIIL = value of current report's Int. Img Loc ien
S RAERR=0
S RACLC0=$G(^RA(79.1,+$G(RAMLC),0)) Q:RACLC0=""
S RAIIL=$G(^RARPT(RARPT,"BA"))
S RADT0=$G(^RADPT(RADFN,"DT",RADTI,0))
S RAXITYPI=$P(RADT0,U,2) ; Exam's Img Type, Internal
S RAXITYPE=$P(^RA(79.2,+RAXITYPI,0),U) ; Exam's Img Type, External
;
; skip checks if there's Int. Img Loc data and its Credit Method is ok
I RAIIL,$P($G(^RA(79.1,+RAIIL,0)),U,21)'=3 G INPUT
;
I $P(RACLC0,U,21)=3 D
. W !!?5,$C(7),"Your signed-on or switched-to location is ",$P($G(RACCESS(DUZ,"LOC",+$G(RAMLC))),U,2),",",!?5,"which has a Credit Method of '",$P($P($P(^DD(79.1,21,0),U,3),"3:",2),";"),"'."
. W !,?5,"This Credit Method does not allow for Interpretation work.",!
. S RAERR=1
I $P(RACLC0,U,6)'=$P(RADT0,U,2) D
. W !!?5,$C(7),"Your signed-on or switched-to location is ",$P($G(RACCESS(DUZ,"LOC",+$G(RAMLC))),U,2),",",!?5,"which has an Imaging Type of '",$P(^RA(79.2,+$P(RACLC0,U,6),0),U),"'."
. W !?5,"But the exam has an Imaging Type of '"_RAXITYPE,"'."
. S RAERR=2
I RAERR D
. W !!?5,"You may optionally switch your current location to a location that",!?5,"allows either Regular or Interpretation credit. Then that location"
. W !?5,"will be used as the default value to this field.",!
INPUT S DA=RARPT
S DIE="^RARPT("
S DR=86 S:'RAERR DR=DR_"//"_$P(RACCESS(DUZ,"LOC",+RAMLC),U,2)
W ! D ^DIE W !
Q
SIIL() ; Screen Interpreting Imaging Location
; called by DD(74,86's DIC("S")
; check file 79.1 img loc's credit method
I $P(^RA(79.1,+Y,0),U,21)=3 Q 0 ;Img Loc's Credit Meth is Tech Only
I '$D(RADFN) Q 1 ; can't continue, thus default to ok
I '$D(RADTI) Q 1 ; can't continue, thus default to ok
; check file 79.1 img loc against case's imaging location
I $P(^RA(79.1,+Y,0),U,6)'=$P(^RADPT(RADFN,"DT",RADTI,0),U,2) Q 0
; check file 79.1 img loc's INACTIVE dt against case's exam date
I $P(^RA(79.1,+Y,0),U,19),$G(RADTE)]$P(^RA(79.1,+Y,0),U,19) Q 0
Q 1
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRABWRTE 2348 printed Oct 16, 2024@18:34:36 Page 2
RABWRTE ;HISC/SM - Billing Aware Report Entry ;11/19/04 12:35
+1 ;;5.0;Radiology/Nuclear Medicine;**41**;Mar 16,1998
+2 QUIT
ELOC ;Enter Inter. Img. Location
+1 ; called from IN1^RARTE4 & NOEDIT^RARTRPV1
+2 NEW RACLC0,RADT0,RAERR,RAXITYPI,RAXITYPE,RAIIL
+3 ; RACLC0 = current switchedTo/signedOn loc's 0 node
+4 ; RADT0 = exam's DT 0 node
+5 ; RAXITYP = exam's Imaging Type in text
+6 ; RAIIL = value of current report's Int. Img Loc ien
+7 SET RAERR=0
+8 SET RACLC0=$GET(^RA(79.1,+$GET(RAMLC),0))
if RACLC0=""
QUIT
+9 SET RAIIL=$GET(^RARPT(RARPT,"BA"))
+10 SET RADT0=$GET(^RADPT(RADFN,"DT",RADTI,0))
+11 ; Exam's Img Type, Internal
SET RAXITYPI=$PIECE(RADT0,U,2)
+12 ; Exam's Img Type, External
SET RAXITYPE=$PIECE(^RA(79.2,+RAXITYPI,0),U)
+13 ;
+14 ; skip checks if there's Int. Img Loc data and its Credit Method is ok
+15 IF RAIIL
IF $PIECE($GET(^RA(79.1,+RAIIL,0)),U,21)'=3
GOTO INPUT
+16 ;
+17 IF $PIECE(RACLC0,U,21)=3
Begin DoDot:1
+18 WRITE !!?5,$CHAR(7),"Your signed-on or switched-to location is ",$PIECE($GET(RACCESS(DUZ,"LOC",+$GET(RAMLC))),U,2),",",!?5,"which has a Credit Method of '",$PIECE($PIECE($PIECE(^DD(79.1,21,0),U,3),"3:",2),";"),"'."
+19 WRITE !,?5,"This Credit Method does not allow for Interpretation work.",!
+20 SET RAERR=1
End DoDot:1
+21 IF $PIECE(RACLC0,U,6)'=$PIECE(RADT0,U,2)
Begin DoDot:1
+22 WRITE !!?5,$CHAR(7),"Your signed-on or switched-to location is ",$PIECE($GET(RACCESS(DUZ,"LOC",+$GET(RAMLC))),U,2),",",!?5,"which has an Imaging Type of '",$PIECE(^RA(79.2,+$PIECE(RACLC0,U,6),0),U),"'."
+23 WRITE !?5,"But the exam has an Imaging Type of '"_RAXITYPE,"'."
+24 SET RAERR=2
End DoDot:1
+25 IF RAERR
Begin DoDot:1
+26 WRITE !!?5,"You may optionally switch your current location to a location that",!?5,"allows either Regular or Interpretation credit. Then that location"
+27 WRITE !?5,"will be used as the default value to this field.",!
End DoDot:1
INPUT SET DA=RARPT
+1 SET DIE="^RARPT("
+2 SET DR=86
if 'RAERR
SET DR=DR_"//"_$PIECE(RACCESS(DUZ,"LOC",+RAMLC),U,2)
+3 WRITE !
DO ^DIE
WRITE !
+4 QUIT
SIIL() ; Screen Interpreting Imaging Location
+1 ; called by DD(74,86's DIC("S")
+2 ; check file 79.1 img loc's credit method
+3 ;Img Loc's Credit Meth is Tech Only
IF $PIECE(^RA(79.1,+Y,0),U,21)=3
QUIT 0
+4 ; can't continue, thus default to ok
IF '$DATA(RADFN)
QUIT 1
+5 ; can't continue, thus default to ok
IF '$DATA(RADTI)
QUIT 1
+6 ; check file 79.1 img loc against case's imaging location
+7 IF $PIECE(^RA(79.1,+Y,0),U,6)'=$PIECE(^RADPT(RADFN,"DT",RADTI,0),U,2)
QUIT 0
+8 ; check file 79.1 img loc's INACTIVE dt against case's exam date
+9 IF $PIECE(^RA(79.1,+Y,0),U,19)
IF $GET(RADTE)]$PIECE(^RA(79.1,+Y,0),U,19)
QUIT 0
+10 QUIT 1
