RARTRPV1 ;HISC/FPT - Resident Pre-Verify Report ;11/16/98 15:02
;;5.0;Radiology/Nuclear Medicine;**5,41**;Mar 16, 1998
EDTRPT ; edit report text and pre-verify
S RACT=$S('$D(^RARPT(RARPT,"L",0)):"I",1:"E")
S:'$D(^RARPT(RARPT,"T")) ^("T")=""
S DA=RARPT,DR="[RA PRE-VERIFY REPORT EDIT]",DIE="^RARPT("
D ^DIE K DE,DQ,DR
S:$D(Y) DUOUT=1
Q
;
NOEDIT ; pre-verify a report only, no report text edit
S DIE("NO^")="",DA=RARPT,DR="[RA PRE-VERIFY REPORT ONLY]",DIE="^RARPT("
D ^DIE K DE,DIE,DQ,DR
S:$D(Y) DUOUT=1
I $D(DTOUT)!($D(DUOUT)) G NEXT
D PDX I RAXIT!($D(DTOUT))!($D(DUOUT)) G NEXT
I ($P(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0),U,13)]"") D SDX
I RAXIT!($D(DTOUT))!($D(DUOUT)) G NEXT
D PSTAFF I RAXIT!($D(DTOUT))!($D(DUOUT)) G NEXT
I ($P(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0),U,15)]"") D SSTAFF
D ELOC^RABWRTE ; Billing Aware -- ask Inter. Img Loc
NEXT ; copy dx & phys, then return to RARTRPV and get next report
; rpt exists & locked, thus no need to lock at "DT" level because users
; can only use 'report entry/edit' option to enter dx's for printsets
N:'$D(RAPRTSET) RAPRTSET N:'$D(RAMEMARR) RAMEMARR
D EN2^RAUTL20(.RAMEMARR)
I RAPRTSET S RAXIT=0 D
. S RADRS=1 D COPY^RARTE2 ; copy dx
. S RADRS=2 D COPY^RARTE2 ; copy resid and staff
. Q
K RAXIT
I $P(^RARPT(RARPT,0),U,5)="R" D RPT^RAHLRPC
I $D(DTOUT) K ^TMP($J,"RA")
I '$D(DTOUT) I $G(RARDX)="S" D
. D SAVE^RARTVER2
. ; for 'Resident On-Line Pre-Verification' default device selection is
. ; the "REPORT PRINTER NAME"
. S %ZIS("B")=$P($G(RAMLC),"^",10) K:%ZIS("B")']"" %ZIS("B")
. D Q^RARTR,RESTORE^RARTVER2
. K:$D(%ZIS("B")) %ZIS("B")
. Q
G GETRPT^RARTRPV
;
PDX ; primary diagnostic code
S DA(2)=RADFN,DA(1)=RADTI,DA=RACNI
S DIE="^RADPT("_DA(2)_",""DT"","_DA(1)_",""P"",",DR=13
S RAXIT=$$LOCK^RAUTL12(DIE,.DA)
I 'RAXIT D ^DIE D UNLOCK^RAUTL12(DIE,.DA) K DA,DE,DQ,DIE,DR
Q
SDX ; secondary diagnostic code
S DR="50///"_RACN
S DR(2,70.03)=13.1
S DR(3,70.14)=.01
S DA(1)=RADFN,DA=RADTI,DIE="^RADPT("_DA(1)_",""DT"","
S RAXIT=$$LOCK^RAUTL12(DIE,.DA)
I 'RAXIT D ^DIE D UNLOCK^RAUTL12(DIE,.DA) K DA,DE,DQ,DIE,DR
Q
PSTAFF ; primary staff
S DA(2)=RADFN,DA(1)=RADTI,DA=RACNI
S DIE="^RADPT("_DA(2)_",""DT"","_DA(1)_",""P"",",DR=15
S RAXIT=$$LOCK^RAUTL12(DIE,.DA)
I 'RAXIT D ^DIE D UNLOCK^RAUTL12(DIE,.DA) K DA,DE,DQ,DIE,DR
Q
SSTAFF ; secondary staff
S DR="50///"_RACN
S DR(2,70.03)=60
S DR(3,70.11)=.01
S DA(1)=RADFN,DA=RADTI,DIE="^RADPT("_DA(1)_",""DT"","
S RAXIT=$$LOCK^RAUTL12(DIE,.DA)
I 'RAXIT D ^DIE D UNLOCK^RAUTL12(DIE,.DA) K DA,DE,DQ,DIE,DR
Q
RARTRPV1 ;HISC/FPT - Resident Pre-Verify Report ;11/16/98 15:02
+1 ;;5.0;Radiology/Nuclear Medicine;**5,41**;Mar 16, 1998
EDTRPT ; edit report text and pre-verify
+1 SET RACT=$SELECT('$DATA(^RARPT(RARPT,"L",0)):"I",1:"E")
+2 IF '$DATA(^RARPT(RARPT,"T"))
SET ^("T")=""
+3 SET DA=RARPT
SET DR="[RA PRE-VERIFY REPORT EDIT]"
SET DIE="^RARPT("
+4 DO ^DIE
KILL DE,DQ,DR
+5 IF $DATA(Y)
SET DUOUT=1
+6 QUIT
+7 ;
NOEDIT ; pre-verify a report only, no report text edit
+1 SET DIE("NO^")=""
SET DA=RARPT
SET DR="[RA PRE-VERIFY REPORT ONLY]"
SET DIE="^RARPT("
+2 DO ^DIE
KILL DE,DIE,DQ,DR
+3 IF $DATA(Y)
SET DUOUT=1
+4 IF $DATA(DTOUT)!($DATA(DUOUT))
GOTO NEXT
+5 DO PDX
IF RAXIT!($DATA(DTOUT))!($DATA(DUOUT))
GOTO NEXT
+6 IF ($PIECE(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0),U,13)]"")
DO SDX
+7 IF RAXIT!($DATA(DTOUT))!($DATA(DUOUT))
GOTO NEXT
+8 DO PSTAFF
IF RAXIT!($DATA(DTOUT))!($DATA(DUOUT))
GOTO NEXT
+9 IF ($PIECE(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0),U,15)]"")
DO SSTAFF
+10 ; Billing Aware -- ask Inter. Img Loc
DO ELOC^RABWRTE
NEXT ; copy dx & phys, then return to RARTRPV and get next report
+1 ; rpt exists & locked, thus no need to lock at "DT" level because users
+2 ; can only use 'report entry/edit' option to enter dx's for printsets
+3 IF '$DATA(RAPRTSET)
NEW RAPRTSET
IF '$DATA(RAMEMARR)
NEW RAMEMARR
+4 DO EN2^RAUTL20(.RAMEMARR)
+5 IF RAPRTSET
SET RAXIT=0
Begin DoDot:1
+6 ; copy dx
SET RADRS=1
DO COPY^RARTE2
+7 ; copy resid and staff
SET RADRS=2
DO COPY^RARTE2
+8 QUIT
End DoDot:1
+9 KILL RAXIT
+10 IF $PIECE(^RARPT(RARPT,0),U,5)="R"
DO RPT^RAHLRPC
+11 IF $DATA(DTOUT)
KILL ^TMP($JOB,"RA")
+12 IF '$DATA(DTOUT)
IF $GET(RARDX)="S"
Begin DoDot:1
+13 DO SAVE^RARTVER2
+14 ; for 'Resident On-Line Pre-Verification' default device selection is
+15 ; the "REPORT PRINTER NAME"
+16 SET %ZIS("B")=$PIECE($GET(RAMLC),"^",10)
IF %ZIS("B")']""
KILL %ZIS("B")
+17 DO Q^RARTR
DO RESTORE^RARTVER2
+18 IF $DATA(%ZIS("B"))
KILL %ZIS("B")
+19 QUIT
End DoDot:1
+20 GOTO GETRPT^RARTRPV
+21 ;
PDX ; primary diagnostic code
+1 SET DA(2)=RADFN
SET DA(1)=RADTI
SET DA=RACNI
+2 SET DIE="^RADPT("_DA(2)_",""DT"","_DA(1)_",""P"","
SET DR=13
+3 SET RAXIT=$$LOCK^RAUTL12(DIE,.DA)
+4 IF 'RAXIT
DO ^DIE
DO UNLOCK^RAUTL12(DIE,.DA)
KILL DA,DE,DQ,DIE,DR
+5 QUIT
SDX ; secondary diagnostic code
+1 SET DR="50///"_RACN
+2 SET DR(2,70.03)=13.1
+3 SET DR(3,70.14)=.01
+4 SET DA(1)=RADFN
SET DA=RADTI
SET DIE="^RADPT("_DA(1)_",""DT"","
+5 SET RAXIT=$$LOCK^RAUTL12(DIE,.DA)
+6 IF 'RAXIT
DO ^DIE
DO UNLOCK^RAUTL12(DIE,.DA)
KILL DA,DE,DQ,DIE,DR
+7 QUIT
PSTAFF ; primary staff
+1 SET DA(2)=RADFN
SET DA(1)=RADTI
SET DA=RACNI
+2 SET DIE="^RADPT("_DA(2)_",""DT"","_DA(1)_",""P"","
SET DR=15
+3 SET RAXIT=$$LOCK^RAUTL12(DIE,.DA)
+4 IF 'RAXIT
DO ^DIE
DO UNLOCK^RAUTL12(DIE,.DA)
KILL DA,DE,DQ,DIE,DR
+5 QUIT
SSTAFF ; secondary staff
+1 SET DR="50///"_RACN
+2 SET DR(2,70.03)=60
+3 SET DR(3,70.11)=.01
+4 SET DA(1)=RADFN
SET DA=RADTI
SET DIE="^RADPT("_DA(1)_",""DT"","
+5 SET RAXIT=$$LOCK^RAUTL12(DIE,.DA)
+6 IF 'RAXIT
DO ^DIE
DO UNLOCK^RAUTL12(DIE,.DA)
KILL DA,DE,DQ,DIE,DR
+7 QUIT
