RABWRTE.m

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

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