- 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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRARTRPV1 2623 printed Feb 19, 2025@00:05:47 Page 2
- 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