source: FOIAVistA/trunk/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RAUTL9.m@ 1780

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

initial load of FOIAVistA 6/30/08 version
File size: 6.2 KB
Line 
1RAUTL9 ;HISC/FPT-Utility Routines ;4/9/97 10:08
2 ;;5.0;Radiology/Nuclear Medicine;**13,27,51**;Mar 16, 1998
3EN1 ; allow lower & uppercase response to REPORT STATUS field
4 ; called from [RA REPORT EDIT] & [RA VERIFY REPORT ONLY]
5 ; " " routine UNVER+2^RARTE1
6 ;
7 N Y K DIR,DIROUT,DIRUT,DTOUT,DUOUT
8 N RAMT S RAMT=0 ; RAMT=$S(Report status before edit="":0,1:1)
9 D IARU
10 I RATRUE=1 S DIR(0)="S^V:VERIFIED;R:RELEASED/NOT VERIFIED;PD:PROBLEM DRAFT;D:DRAFT"
11 I RATRUE=0 S DIR(0)="S^V:VERIFIED;PD:PROBLEM DRAFT;D:DRAFT"
12 S DIR("A")="REPORT STATUS"
13 S:$P(^RARPT(D0,0),"^",5)="" RAMT=1
14 S:$P(^RARPT(D0,0),"^",5)]"" DIR("B")=$P(^RARPT(D0,0),"^",5)
15 S:RAMT DIR("B")="D" ; default to 'Draft' if missing report status
16 D ^DIR K DIR,RATRUE
17 I $D(DIRUT),(RAMT) D
18 . S $P(^RARPT(D0,0),"^",5)="D" D ENSET^RAXREF(74,5,"D",D0)
19 . ; set Report Status to 'Draft' if originally null, and user times out
20 . ; or '^' out! Make sure xrefs are set!
21 . Q
22 Q:$D(DIRUT)
23 I $E(Y)="V",'$D(^XUSEC("RA VERIFY",DUZ)) W !!,*7,"You do not have the appropriate privileges to verify a report." G EN1
24 S RASTATX=$E(Y) S:RASTATX="P" RASTATX="PD"
25 Q
26EN2 ; residents enter report status to pre-verify
27 ; called from input templates [RA PRE-VERIFY REPORT EDIT] and [RA PRE-
28 ; VERIFY REPORT ONLY]
29 N Y K DIR,DIROUT,DIRUT,DTOUT,DUOUT
30 N RAMT S RAMT=0 ; RAMT=$S(Report status before edit="":0,1:1)
31 D IARU
32 I RATRUE=1 S DIR(0)="S^R:RELEASED/NOT VERIFIED;PD:PROBLEM DRAFT;D:DRAFT"
33 I RATRUE=0 S DIR(0)="S^PD:PROBLEM DRAFT;D:DRAFT"
34 S DIR("A")="RESIDENT PRE-VERIFICATION REPORT STATUS"
35 S:$P(^RARPT(D0,0),"^",5)="" RAMT=1
36 S:$P(^RARPT(D0,0),"^",5)]"" DIR("B")=$P(^RARPT(D0,0),"^",5)
37 S:RAMT DIR("B")="D" ; default to 'Draft' if missing report status
38 D ^DIR K DIR,RATRUE
39 I $D(DIRUT),(RAMT) D
40 . S $P(^RARPT(D0,0),"^",5)="D" D ENSET^RAXREF(74,5,"D",D0)
41 . ; set Report Status to 'Draft' if originally null, and user times out
42 . ; or '^' out! Make sure xrefs are set!
43 . Q
44 Q:$D(DIRUT)
45 S RASTATX=$E(Y) S:RASTATX="P" RASTATX="PD"
46 Q
47EN3 ; residents pre-verify a report
48 N Y K DIR,DIROUT,DIRUT,DTOUT,DUOUT
49 W ! S DIR(0)="Y",DIR("A")="WANT TO PRE-VERIFY THIS REPORT"
50 S DIR("?")="Answer YES to mark this report as pre-verified. Your user ID number, electronic signature code and the current date/time will be stored in the pre-verification fields of this entry."
51 D ^DIR K DIR
52 W ! Q:$D(DIRUT)
53 S RAYN=+Y
54 Q
55EN4 ; re-display report text question
56 N Y K DIR,DIROUT,DIRUT,DTOUT,DUOUT
57 S DIR(0)="Y",DIR("A")="Want to View the Report Text again" D ^DIR K DIR
58 W ! Q:$D(DIRUT)
59 S RAYN=Y
60 Q
61EXIST ; Checks if word processing data exists called from [RA REPORT EDIT]
62 ; and [RA PRE-VERIFY REPORT EDIT] templates.
63 I RANODE="H",(($D(DTOUT))!($D(DUOUT))) D Q
64 . D CHRSTOR
65 I RANODE="R",(($D(DTOUT))!($D(DUOUT))) Q
66 I RANODE="I",(($D(DTOUT))!($D(DUOUT))) Q
67 I +$O(^RARPT(DA,RANODE,0)) D Q
68 . N CNT,X,X1,X2,X3,X4,RAWPFLG S (RAWPFLG,X)=0
69 . F S X=$O(^RARPT(DA,RANODE,X)) Q:X'>0 D Q:RAWPFLG
70 .. S (CNT,X2)=0
71 .. S X1=$G(^RARPT(DA,RANODE,X,0)) Q:X1']""
72 .. S X2=$L(X1)
73 .. F X3=1:1:X2 D Q:RAWPFLG
74 ... S X4=$E(X1,X3) S:X4?1AN CNT=CNT+1
75 ... S:X4'?1AN&(CNT>0) CNT=0
76 ... S:CNT=2 RAWPFLG=1
77 ... Q
78 .. Q
79 . I 'RAWPFLG D
80 .. S Y=$S(RANODE="H":"@1",RANODE="R":"@2",1:"@3")
81 .. W " ?? Invalid "
82 .. W $S(RANODE="H":"Clinical History",RANODE="R":"Report",1:"Impression")
83 .. W " text.",$C(7)
84 .. K ^RARPT(DA,RANODE) ; Clear out bad WP
85 .. Q
86 . I RANODE="H",('RAWPFLG) D CHRSTOR
87 . Q
88 Q
89CHRSTOR ; Restores original data to the Clinical History field in the
90 ; Rad/Nuc Med Reports File. Global: ^RARPT( File #: 74
91 ; Set ^RARPT('DA',"H") array to value in ^TMP($J,"RA Clin Hist")
92 N %X,%Y,Y
93 S %X="^TMP($J,""RA Clin Hist"",",%Y="^RARPT("_DA_",""H"","
94 D %XY^%RCR K ^TMP($J,"RA Clin Hist")
95 Q
96CHSAVE ; Checks if word processing data exists called from [RA REPORT EDIT]
97 ; and [RA PRE-VERIFY REPORT EDIT] templates. For the 'Clinical History'
98 ; field.
99 ; Save off existing text in a ^TMP global.
100 K ^TMP($J,"RA Clin Hist") N %X,%Y
101 S %X="^RARPT("_DA_",""H"",",%Y="^TMP($J,""RA Clin Hist"","
102 D %XY^%RCR
103 Q
104CHPRINT ; Prints text from the 'Clinical History' field in file 70
105 ; from [RA REPORT EDIT] template. Added with patch RA*5*27 - bnt
106 ;
107 N DIR,DTOUT,DUOUT
108 D EN^DDIOL("CLINICAL HISTORY:")
109 S DIWL=1,DIWF="|WC75",RAV=0 K ^UTILITY($J,"W")
110 F S RAV=$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"H",RAV)) Q:RAV'>0 D
111 . S X=^RADPT(RADFN,"DT",RADTI,"P",RACNI,"H",RAV,0)
112 . D ^DIWP
113 D ^DIWW S X=""
114 Q
115OUTTEXT(X,DIWF,DIWL,DIWR,RAFMAT,RALFF,RATFF) ; Output generic text using DIWP
116 ;INPUT VARIABLES:
117 ; 'X' --> Text to be formatted 'DIWF' --> Format control data
118 ; 'DIWL' --> Left margin 'DIWR' --> Right margin
119 ; 'RAFMAT' --> Tabs for columns 'RALFF' --> Leading line feed
120 ; 'RATFF' --> Trailing line feed
121 N DIW,DIWI,DIWT,DIWTC,DIWX,RALFMAT,RATFMAT,Y,Z
122 Q:X']"" S RAFMAT=+$G(RAFMAT)
123 S RALFF=$TR($G(RALFF),$G(RALFF),"!")
124 S RATFF=$TR($G(RATFF),$G(RATFF),"!")
125 S RALFMAT=RALFF_"?"_RAFMAT,RATFMAT=RATFF
126 K ^UTILITY($J,"W",DIWL) D ^DIWP
127 S Y=0 F S Y=$O(^UTILITY($J,"W",DIWL,Y)) Q:Y'>0 D
128 . S Y(0)=$G(^UTILITY($J,"W",DIWL,Y,0)) W @RALFMAT,Y(0)
129 . S Z=$O(^UTILITY($J,"W",DIWL,Y))
130 . W:RATFMAT]""&(Z>0) @RATFF
131 . Q
132 K ^UTILITY($J,"W")
133 Q
134STOPCHK ; does user want to stop task?
135 I $$S^%ZTLOAD D
136 . S ZTSTOP=1 K ZTREQ
137 . W !?10,"*** OUTPUT STOPPED AT USER'S REQUEST ***"
138 . W !?10,"Option Name: ",$S($P($G(XQY0),"^")]"":$P($G(XQY0),"^"),1:"Unknown")
139 . W !?10,"Option Menu Text: ",$S($P($G(XQY0),"^",2)]"":$P($G(XQY0),"^",2),1:"Unknown")
140 . W !?10,"Task #: ",$S(+$G(ZTSK)>0:+$G(ZTSK),1:"Unknown")
141 . Q
142 Q
143UPDTPNT(RAIEN) ; Remove the possibility of broken pointers when a report
144 ; is deleted from the Rad/Nuc Med Reports file (74). This checks the
145 ; following files: Report Batches file (74.2) and the
146 ; Report Distribution file (74.4)
147 N A,B,DA,DIK
148 I $D(^RABTCH(74.2,"D",RAIEN)) D
149 . S A=0 F S A=$O(^RABTCH(74.2,"D",RAIEN,A)) Q:A'>0 D
150 .. S B=0 F S B=$O(^RABTCH(74.2,"D",RAIEN,A,B)) Q:B'>0 D
151 ... S DA=B,DA(1)=A,DIK="^RABTCH(74.2,"_DA(1)_",""R"","
152 ... D ^DIK K DA,DIK
153 ... Q
154 .. Q
155 . Q
156 I $D(^RABTCH(74.4,"B",RAIEN)) D
157 . S A=0 F S A=$O(^RABTCH(74.4,"B",RAIEN,A)) Q:A'>0 D
158 .. S DA=A,DIK="^RABTCH(74.4," D ^DIK K DA,DIK
159 .. Q
160 . Q
161 Q
162IARU ; Imaging Location allows released/unverified
163 S RATRUE=$S($P(^RA(79.1,+$P(^RADPT(RADFN,"DT",RADTI,0),U,4),0),U,17)="Y":1,1:0)
164 Q
Note: See TracBrowser for help on using the repository browser.