source: WorldVistAEHR/trunk/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RARTRPV1.m@ 862

Last change on this file since 862 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.5 KB
Line 
1RARTRPV1 ;HISC/FPT - Resident Pre-Verify Report ;11/16/98 15:02
2 ;;5.0;Radiology/Nuclear Medicine;**5,41**;Mar 16, 1998
3EDTRPT ; edit report text and pre-verify
4 S RACT=$S('$D(^RARPT(RARPT,"L",0)):"I",1:"E")
5 S:'$D(^RARPT(RARPT,"T")) ^("T")=""
6 S DA=RARPT,DR="[RA PRE-VERIFY REPORT EDIT]",DIE="^RARPT("
7 D ^DIE K DE,DQ,DR
8 S:$D(Y) DUOUT=1
9 Q
10 ;
11NOEDIT ; pre-verify a report only, no report text edit
12 S DIE("NO^")="",DA=RARPT,DR="[RA PRE-VERIFY REPORT ONLY]",DIE="^RARPT("
13 D ^DIE K DE,DIE,DQ,DR
14 S:$D(Y) DUOUT=1
15 I $D(DTOUT)!($D(DUOUT)) G NEXT
16 D PDX I RAXIT!($D(DTOUT))!($D(DUOUT)) G NEXT
17 I ($P(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0),U,13)]"") D SDX
18 I RAXIT!($D(DTOUT))!($D(DUOUT)) G NEXT
19 D PSTAFF I RAXIT!($D(DTOUT))!($D(DUOUT)) G NEXT
20 I ($P(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0),U,15)]"") D SSTAFF
21 D ELOC^RABWRTE ; Billing Aware -- ask Inter. Img Loc
22NEXT ; copy dx & phys, then return to RARTRPV and get next report
23 ; rpt exists & locked, thus no need to lock at "DT" level because users
24 ; can only use 'report entry/edit' option to enter dx's for printsets
25 N:'$D(RAPRTSET) RAPRTSET N:'$D(RAMEMARR) RAMEMARR
26 D EN2^RAUTL20(.RAMEMARR)
27 I RAPRTSET S RAXIT=0 D
28 . S RADRS=1 D COPY^RARTE2 ; copy dx
29 . S RADRS=2 D COPY^RARTE2 ; copy resid and staff
30 . Q
31 K RAXIT
32 I $P(^RARPT(RARPT,0),U,5)="R" D RPT^RAHLRPC
33 I $D(DTOUT) K ^TMP($J,"RA")
34 I '$D(DTOUT) I $G(RARDX)="S" D
35 . D SAVE^RARTVER2
36 . ; for 'Resident On-Line Pre-Verification' default device selection is
37 . ; the "REPORT PRINTER NAME"
38 . S %ZIS("B")=$P($G(RAMLC),"^",10) K:%ZIS("B")']"" %ZIS("B")
39 . D Q^RARTR,RESTORE^RARTVER2
40 . K:$D(%ZIS("B")) %ZIS("B")
41 . Q
42 G GETRPT^RARTRPV
43 ;
44PDX ; primary diagnostic code
45 S DA(2)=RADFN,DA(1)=RADTI,DA=RACNI
46 S DIE="^RADPT("_DA(2)_",""DT"","_DA(1)_",""P"",",DR=13
47 S RAXIT=$$LOCK^RAUTL12(DIE,.DA)
48 I 'RAXIT D ^DIE D UNLOCK^RAUTL12(DIE,.DA) K DA,DE,DQ,DIE,DR
49 Q
50SDX ; secondary diagnostic code
51 S DR="50///"_RACN
52 S DR(2,70.03)=13.1
53 S DR(3,70.14)=.01
54 S DA(1)=RADFN,DA=RADTI,DIE="^RADPT("_DA(1)_",""DT"","
55 S RAXIT=$$LOCK^RAUTL12(DIE,.DA)
56 I 'RAXIT D ^DIE D UNLOCK^RAUTL12(DIE,.DA) K DA,DE,DQ,DIE,DR
57 Q
58PSTAFF ; primary staff
59 S DA(2)=RADFN,DA(1)=RADTI,DA=RACNI
60 S DIE="^RADPT("_DA(2)_",""DT"","_DA(1)_",""P"",",DR=15
61 S RAXIT=$$LOCK^RAUTL12(DIE,.DA)
62 I 'RAXIT D ^DIE D UNLOCK^RAUTL12(DIE,.DA) K DA,DE,DQ,DIE,DR
63 Q
64SSTAFF ; secondary staff
65 S DR="50///"_RACN
66 S DR(2,70.03)=60
67 S DR(3,70.11)=.01
68 S DA(1)=RADFN,DA=RADTI,DIE="^RADPT("_DA(1)_",""DT"","
69 S RAXIT=$$LOCK^RAUTL12(DIE,.DA)
70 I 'RAXIT D ^DIE D UNLOCK^RAUTL12(DIE,.DA) K DA,DE,DQ,DIE,DR
71 Q
Note: See TracBrowser for help on using the repository browser.