close Warning: Can't use blame annotator: 
svn blame failed on WorldVistAEHR/trunk/r/AUTOMATED_MED_INFO_EXCHANGE-DVBA-DVBC/DVBCUTL4.m: 'GenericSWIGWrapper' object has no attribute '_wrap'

source: WorldVistAEHR/trunk/r/AUTOMATED_MED_INFO_EXCHANGE-DVBA-DVBC/DVBCUTL4.m@ 1800

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

initial load of WorldVistAEHR
File size: 4.6 KB
RevLine 
1DVBCUTL4 ;ALB-ISC/JLU/GTS-A utility routine ;2/22/93
2 ;;2.7;AMIE;**57**;Apr 10, 1995
3 ;
4SITE() ;returns the site's name from the amie parameter file (396.1)
5 N DVBCX
6 S DVBCX=$O(^DVB(396.1,0))
7 I 'DVBCX Q "UNKNOWN"
8 Q $P(^(DVBCX,0),U,1) ;nake on SITE+2
9 ;
10EXAM() ;returns the next exam .01 number in the 396.4 Exam file
11 N DVBA,DVBA1
12 L +^DVB(396.1,1,5):3
13 I '$T Q 0 ;unable to lock parameter file node
14 S DVBA=$P(^DVB(396.1,1,5),U,1)
15 F DVBA1=0:0 S DVBA=DVBA+1 I '$D(^DVB(396.4,"B",DVBA)) Q
16 S $P(^DVB(396.1,1,5),U,1)=DVBA
17 L -^DVB(396.1,1,5)
18 Q DVBA ;contains new .01 value
19 ;
20EXSRH(A,B,C) ;searches for the exam for a specific request.
21 ;A ==> The DIC("A") prompt for 396.6
22 ;B ==> An optional screen on 396.6
23 ;C ==> An optional screen on 396.4
24 ;
25 N ERR
26 DO
27 .I $D(A),A]"" S DIC("A")=A
28 .I $D(B),B]"" S DIC("S")=B
29 .S DIC="^DVB(396.6,",DIC(0)="AEQM"
30 .D ^DIC K DIC
31 .I +Y<0!($D(DTOUT))!(X="")!(X=U) S ERR=-1 Q
32 .I $D(C),C]"" S DIC("S")=C
33 .S X=+Y,DIC="^DVB(396.4,",DIC(0)="EQ"
34 .S D="ARQ"_REQDA
35 .D IX^DIC K DIC,D
36 I $D(ERR),ERR<0 S Y=-1
37 Q Y
38 ;
39ROLLBCK ; ** Sort the ^TMP global to find added exams **
40 S DIK="^DVB(396.4,"
41 N DVBADA,DVBAEXNM,DVBARQDT
42 S (DVBADA,DVBAEXNM,DVBARQDT)=""
43 S DVBARQDT=$P(^DVB(396.3,REQDA,0),U,2)
44 F DVBACNT=0:0 S DVBAEXNM=$O(^TMP($J,"NEW",DVBAEXNM)) Q:DVBAEXNM="" D LOOP2
45 K DVBACNT,DVBADA,DVBAEXNM,DVBARQDT,DIK,DA
46 Q
47 ;
48LOOP2 ; ** Loop through 'PE' X-Ref:delete exams just added **
49 F DVBADA=0:0 S DVBADA=$O(^DVB(396.4,"APE",DFN,DVBAEXNM,DVBARQDT,DVBADA)) Q:DVBADA="" S DA=DVBADA D ^DIK
50 Q
51 ;
52CONTMES ; ** Continue Message to replace HANG statements **
53 W !!," Press RETURN to continue..." R DVBCCONT:DTIME K DVBCCONT
54 Q
55 ;
56EXMLOG1 ; ** Add exam (Called from DVBCADE2) **
57 S (DIC,DIE)="^DVB(396.4,",DIC(0)=""
58 K DD,DO
59 S DIC("DR")=".02////^S X=REQDA;.03////^S X=$P(^TMP($J,""NEW"",EXMNM),U,1);.04////O"
60 D FILE^DICN I $D(Y),(+Y>0) W:$X>40&($L(EXMNM)>30) !
61 W EXMNM_" -added, " W:$X>50 !
62 I $D(Y),+Y<0 W *7,"Exam addition error ! " S OUT=1 H 3 Q
63 S $P(^TMP($J,"NEW",EXMNM),U,3)=+Y
64 I $P(^DVB(396.3,REQDA,0),U,10)="E" DO
65 .I $D(^DVB(396.3,REQDA,5)) DO ;**Insuf 2507 entered after 2.7
66 ..K DTOUT
67 ..S DVBAINDA=+$P(^DVB(396.3,REQDA,5),U,1),DVBCADEX=""
68 ..D INSXM^DVBCUTA1 K DVBCADEX
69 .I '$D(^DVB(396.3,REQDA,5)) DO ;**Insuf 2507 entered prior to 2.7
70 ..N REASON
71 ..S REASON=+$$INRSLK^DVBCUTA3
72 ..I +REASON>0 DO
73 ...K DIE,Y,DA,DR
74 ...S DIE="^DVB(396.4,",DR=".11////^S X=REASON;80;.12"
75 ...S DA=+$P(^TMP($J,"NEW",EXMNM),U,3)
76 ...S DIE("NO^")="" D ^DIE K DIE,DA,DR,Y W !!
77 Q ;Quit to EXMLOG^DVBCADE2
78 ;
79STATCHK ; ** Check Statuses (Called from ^DVBCEDIT) **
80 Q:STAT="O" I STAT="RX" W *7,!!,"This exam has been cancelled by the RO.",!! H 2 S NCN=1 Q
81 I STAT="CT" W *7,!!,"This request has been completed and transferred out.",!! H 2 S NCN=1 Q
82 I STAT="C" W *7,!!,"This exam has been completed.",! S NCN=1 Q
83 I STAT="X" W *7,!!,"This exam has been cancelled by MAS.",!! H 2 S NCN=1 Q
84 I STAT="R" W *7,!!,"This exam has been released to the RO.",!! H 2 S NCN=1 Q
85 Q
86 ;
87COMP ; ** Check to see if transcription completed (Called from ^DVBCEDIT) **
88 K OUT Q:$P(^DVB(396.4,EXMDA,0),U,4)="C" W !!,"Is transcription completed for this exam" S %=2 D YN^DICN I $D(DTOUT) S OUT=1 Q
89 I $D(%Y),(%Y["?") W !!,"Enter Y if all information has been entered and transcription is finished",!,"or N if more information will be entered later",!! G COMP
90 Q:%'=1
91 K DIE,DA,DR
92 S DIE="^DVB(396.4,",DA=EXMDA,DR=".04///C;90///NOW"
93 D ^DIE
94 Q
95 ;
96PAUSE ;this is a pause, only looking for a return or up arrow
97 S DIR(0)="E"
98 D ^DIR
99 K DIR
100 Q
101 ;
102STM ;start response clock
103 I $D(XRTL) D T0^%ZOSV
104 Q
105 ;
106SPM ;stop monitor clock
107 I $D(XRT0) D T1^%ZOSV
108 K XRTN
109 Q
110 ;
111DELSER ;this subroutine will delete the server message
112 S XMZ=XQMSG
113 S XMSER="S."_XQSOP
114 D REMSBMSG^XMA1C
115 Q
116 ;
117PHYS(A) ; ** Question user for access to Physicians Guide **
118 S DIC(0)="AEMQ^^"
119 S DIC("A")="Select exam: "
120 ;S DIR("?")="Enter Yes to access the Physician's Guide using Text Retreival."
121 D ^DIC
122 ;I +Y=1 D PHYS^A1BBTR ;Access Physician's Guide
123 ;I +Y=1 D PHYS^DRSTR ;** Access Physician's Guide
124 S:'$D(Y) Y=""
125 K DIR,X,Y(0)
126 Q Y
127 ;
128DATE(PAR1,PAR2) ;gets the beginning and ending dates from the users
129 ;PAR1 is the beginning date
130 ;PAR2 is the ending date
131 ;
132DATE1 S %DT("A")="Enter the beginning date: "
133 S %DT="AET"
134 D ^%DT
135 I X="^"!($D(DTOUT)) S (PAR1,PAR2)=0 Q
136 I X="" S (PAR1,PAR2)=-1 Q
137 S PAR1=Y
138 K %DT,Y,X,DTOUT
139 S %DT("A")="Enter the ending date: "
140 S %DT="AET"
141 D ^%DT
142 I X="^"!($D(DTOUT)) S (PAR1,PAR2)=0 Q
143 I X="" S (PAR1,PAR2)=-1 Q
144 S PAR2=Y
145 K %DT,X,Y,DTOUT
146 I PAR2<PAR1 DO G DATE1
147 .S VAR(1,0)="1,0,0,2:2,0^Beginning date must be before ending date!"
148 .D WR^DVBAUTL4("VAR")
149 .K VAR,PAR1,PAR2
150 .Q
151 Q
Note: See TracBrowser for help on using the repository browser.