Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: RARTRPV1

RARTRPV1.m

Go to the documentation of this file.
  1. RARTRPV1 ;HISC/FPT - Resident Pre-Verify Report ;11/16/98 15:02
  1. ;;5.0;Radiology/Nuclear Medicine;**5,41**;Mar 16, 1998
  1. EDTRPT ; edit report text and pre-verify
  1. S RACT=$S('$D(^RARPT(RARPT,"L",0)):"I",1:"E")
  1. S:'$D(^RARPT(RARPT,"T")) ^("T")=""
  1. S DA=RARPT,DR="[RA PRE-VERIFY REPORT EDIT]",DIE="^RARPT("
  1. D ^DIE K DE,DQ,DR
  1. S:$D(Y) DUOUT=1
  1. Q
  1. ;
  1. NOEDIT ; pre-verify a report only, no report text edit
  1. S DIE("NO^")="",DA=RARPT,DR="[RA PRE-VERIFY REPORT ONLY]",DIE="^RARPT("
  1. D ^DIE K DE,DIE,DQ,DR
  1. S:$D(Y) DUOUT=1
  1. I $D(DTOUT)!($D(DUOUT)) G NEXT
  1. D PDX I RAXIT!($D(DTOUT))!($D(DUOUT)) G NEXT
  1. I ($P(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0),U,13)]"") D SDX
  1. I RAXIT!($D(DTOUT))!($D(DUOUT)) G NEXT
  1. D PSTAFF I RAXIT!($D(DTOUT))!($D(DUOUT)) G NEXT
  1. I ($P(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0),U,15)]"") D SSTAFF
  1. D ELOC^RABWRTE ; Billing Aware -- ask Inter. Img Loc
  1. 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
  1. ; can only use 'report entry/edit' option to enter dx's for printsets
  1. N:'$D(RAPRTSET) RAPRTSET N:'$D(RAMEMARR) RAMEMARR
  1. D EN2^RAUTL20(.RAMEMARR)
  1. I RAPRTSET S RAXIT=0 D
  1. . S RADRS=1 D COPY^RARTE2 ; copy dx
  1. . S RADRS=2 D COPY^RARTE2 ; copy resid and staff
  1. . Q
  1. K RAXIT
  1. I $P(^RARPT(RARPT,0),U,5)="R" D RPT^RAHLRPC
  1. I $D(DTOUT) K ^TMP($J,"RA")
  1. I '$D(DTOUT) I $G(RARDX)="S" D
  1. . D SAVE^RARTVER2
  1. . ; for 'Resident On-Line Pre-Verification' default device selection is
  1. . ; the "REPORT PRINTER NAME"
  1. . S %ZIS("B")=$P($G(RAMLC),"^",10) K:%ZIS("B")']"" %ZIS("B")
  1. . D Q^RARTR,RESTORE^RARTVER2
  1. . K:$D(%ZIS("B")) %ZIS("B")
  1. . Q
  1. G GETRPT^RARTRPV
  1. ;
  1. PDX ; primary diagnostic code
  1. S DA(2)=RADFN,DA(1)=RADTI,DA=RACNI
  1. S DIE="^RADPT("_DA(2)_",""DT"","_DA(1)_",""P"",",DR=13
  1. S RAXIT=$$LOCK^RAUTL12(DIE,.DA)
  1. I 'RAXIT D ^DIE D UNLOCK^RAUTL12(DIE,.DA) K DA,DE,DQ,DIE,DR
  1. Q
  1. SDX ; secondary diagnostic code
  1. S DR="50///"_RACN
  1. S DR(2,70.03)=13.1
  1. S DR(3,70.14)=.01
  1. S DA(1)=RADFN,DA=RADTI,DIE="^RADPT("_DA(1)_",""DT"","
  1. S RAXIT=$$LOCK^RAUTL12(DIE,.DA)
  1. I 'RAXIT D ^DIE D UNLOCK^RAUTL12(DIE,.DA) K DA,DE,DQ,DIE,DR
  1. Q
  1. PSTAFF ; primary staff
  1. S DA(2)=RADFN,DA(1)=RADTI,DA=RACNI
  1. S DIE="^RADPT("_DA(2)_",""DT"","_DA(1)_",""P"",",DR=15
  1. S RAXIT=$$LOCK^RAUTL12(DIE,.DA)
  1. I 'RAXIT D ^DIE D UNLOCK^RAUTL12(DIE,.DA) K DA,DE,DQ,DIE,DR
  1. Q
  1. SSTAFF ; secondary staff
  1. S DR="50///"_RACN
  1. S DR(2,70.03)=60
  1. S DR(3,70.11)=.01
  1. S DA(1)=RADFN,DA=RADTI,DIE="^RADPT("_DA(1)_",""DT"","
  1. S RAXIT=$$LOCK^RAUTL12(DIE,.DA)
  1. I 'RAXIT D ^DIE D UNLOCK^RAUTL12(DIE,.DA) K DA,DE,DQ,DIE,DR
  1. Q