source: WorldVistAEHR/trunk/r/AUTOMATED_MED_INFO_EXCHANGE-DVBA-DVBC/DVBAREG1.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: 5.2 KB
Line 
1DVBAREG1 ;ALB/JLU;557/THM-REQ FOR ADMITTED VETS ; 10/29/90 7:53 AM
2 ;;2.7;AMIE;**14**;Apr 10, 1995
3EN ;this is the main entry point for the driver
4 D TERM
5 I '$D(DVBAQUIT) DO
6 .F D BODY Q:$D(DVBAQUIT)
7 .Q
8 D EXIT^DVBAUTIL
9 Q
10 ;
11TERM ;this subroutine will set various necessary variables
12 ;
13 K DVBAQUIT
14 D DUZ2^DVBAUTIL
15 Q:$D(DVBAQUIT)
16 D NOPARM^DVBAUTL2
17 Q:$D(DVBAQUIT)
18 D HOME^%ZIS
19 Q:$D(DVBAQUIT)
20 S OPER=$S($D(^VA(200,+DUZ,0)):$P(^(0),U,1),1:"Unknown")
21 S HD="PATIENT LOOKUP"
22 S LOC=$S($D(^DIC(4,+DUZ(2),0)):$P(^(0),U,1),1:"")
23 S HNAME=$$SITE^DVBCUTL4()
24 S DVBAENTR=0
25 Q
26 ;
27BODY ;this subroutine is a subdriver for this functionality
28 S DVBAENTR=0
29 D UNLOCK^DVBAUTL6(DVBAENTR) ;unlocks the record
30 D CLEAN^DVBAREG2 ;cleans up some variables
31 D PAGE^DVBAREG2 ;checks for bottom of the screen or page
32 D SET1^DVBAREG3 ;sets a few variables
33 S DFN=$$PAT^DVBAREG3() ;function call to get the patient
34 I DFN=0 S DVBAQUIT=1 Q
35 D SET2^DVBAREG3 ;sets up patient information variables
36 D CLEAR^DVBAUTL4
37 D DTRNG^DVBAREG2(DFN) ;gets the date range
38 I $D(DVBAQUIT)!($D(DVBASTOP)) Q
39 I DVBBDT>0 S DVBCHK=$$CHK(DFN,DVBBDT,DVBEDT)
40 I DVBBDT=0 S DVBCHK=$$CHK(DFN,2010101,DT)
41 D CLEAR^DVBAUTL4
42 I DVBCHK=0 D ERR^DVBAUTL6(DVBBDT) S DVBASTOP=1 Q
43 I DVBCHK="B" D QUEST1(DFN) Q:$D(DVBAQUIT)
44 D OLD^DVBAREN1
45 D DISPLAY
46 Q:$D(DVBAQUIT)
47 ;
48 ;*The following line of code was removed as part of the coding to allow
49 ;* Admission and Activity 7131s with the same date
50 ;I $D(DVBANS) S DVBDOC=$$DOC^DVBAREG3(DVBANS)
51 I '$D(DVBANS) DO SRCH I $D(DVBASTOP)!($D(DVBAQUIT))!('$D(DVBAENTR)) Q
52 I $D(DVBANS) D SELECT^DVBAREG2
53 Q:$D(DVBASTOP)!($D(DVBAQUIT))
54 D ^DVBARQP
55 D UNLOCK^DVBAUTL6(DVBAENTR)
56 Q
57 ;
58CHK(A,B,C) ;checks for the existance of admissions, appointments, dispositions
59 ;or stop codes
60 ;A is the DFN of the Patient
61 ;B is the beginning date
62 ;C is the ending date
63 ;If all is selected then B and C should be dates that encompise all
64 ;possible dates
65 ;the date ranges provided must iclude the +/-for end of days
66 N ADM,APT,DISP,SPCOD,B1,C1,C2,DVBADM,DVBAPT,DVBDISP,DVBSPCOD,DVBENC,DVBZERR
67 S (DVBADM,DVBAPT,DVBDISP,DVBSPCOD)=0
68 S B1=9999999.9999999-B
69 S C1=9999999.9999999-C
70 S ADM=$O(^DGPM("APTT1",+A,B))
71 I ADM,ADM'>C S DVBADM=1
72 S APT=$O(^DPT(+A,"S",B))
73 I APT,APT'>C S DVBAPT=1
74 S DISP=$O(^DPT(+A,"DIS",C1))
75 I DISP,DISP'>B1 S DVBDISP=1
76 ; Scheduling conversion
77 S SPCOD=$$EXOE^SDOE(+A,B,9999999,,"DVBZERR")
78 I SPCOD D GETGEN^SDOE(SPCOD,"DVBENC","DVBZERR") S SPCOD=$G(DVBENC(0))\1
79 ;
80 I SPCOD,SPCOD'>C S DVBSPCOD=1
81 I DVBADM&((DVBAPT)!(DVBDISP)!(DVBSPCOD)) Q "B"
82 I DVBADM Q "A"
83 I DVBAPT!(DVBDISP)!(DVBSPCOD) Q "N"
84 Q 0
85 ;
86QUEST1(DFN) ;ask user which they wish to see admission or non
87 S DIR("A")="Which would you prefer"
88 S DIR("A",1)=$P(DFN,U,2)_" has both Admission and Non Admission information."
89 S DIR(0)="SM^A:Admissions;N:Non Admissions;B:Both"
90 D ^DIR
91 K DIR
92 I $D(DTOUT)!($D(DUOUT))!(X="") S DVBAQUIT=1 Q
93 S DVBCHK=Y
94 Q
95 ;
96DISPLAY ;displays the patient information to the user. Also asks the user
97 ;to select which info.
98 N X1,X2,X3,X4,VAR1
99 I DVBANL=1 D SINGLE^DVBAREG2 Q
100 K DVBANS
101 S X2=$O(^TMP("DVBA",$J,0))
102 I 'X2 S DVBASTOP=1 Q
103 S $P(VAR1," ",5)=""
104 S (X1,DVBCNT)=0
105 F DO Q:$D(DVBASTOP)!($D(DVBANS))
106 .S XTYPE=""
107 .F S XTYPE=$O(^TMP("DVBA",$J,X2,XTYPE)) Q:XTYPE="" DO
108 ..S X1=X1+1
109 ..S DVBCNT=DVBCNT+1
110 ..S VAR(DVBCNT,0)="0,0,0,1,0^"_X1_$E(VAR1,1,5-$L(X1))_$P(^TMP("DVBA",$J,X2,XTYPE),U,1)
111 ..I '(X1#12)!($O(^TMP("DVBA",$J,X2,XTYPE))=""&'$O(^TMP("DVBA",$J,X2))) DO
112 ...D WR^DVBAUTL4("VAR")
113 ...K VAR
114 ...S DVBCNT=0
115 ...D CONT^DVBAREG2
116 .S X2=$O(^TMP("DVBA",$J,X2))
117 .I '$D(DVBANS),('X2) S DVBASTOP=1 Q
118 .Q
119 I $D(DVBANS) DO
120 .S (X3,X4)=0,(DVBTYPE,DVBDOC)=""
121 .F Q:+X3=+DVBANS S X4=$O(^TMP("DVBA",$J,X4)) Q:X4="" DO
122 ..F Q:+X3=+DVBANS S DVBTYPE=$O(^TMP("DVBA",$J,X4,DVBTYPE)) Q:DVBTYPE="" S X3=X3+1
123 .S DVBANS=X4
124 .S DVBDOC=$S(DVBTYPE["ADMISSION":"A",1:"L")
125 .Q
126 K XTYPE
127 Q
128 ;
129SRCH ;searches the 7131 file for an existing 7131 request.
130 K DA,Y,DVBASTOP,DVBAENTR
131 D DICW^DVBAUTIL
132 S VAR(1,0)="0,0,0,2,0^Searching file for existing 7131 requests for "_PNAM
133 D WR^DVBAUTL4("VAR")
134 K VAR
135 S DIC="^DVB(396,",DIC(0)="EM",X=SSN
136 I DVBCHK'="B",DVBBDT=0 S DIC("S")=$S(DVBCHK="A":"I $P(^(2),U,10)=""A""",1:"I $P(^(2),U,10)=""L"""),DVBDOC=$S(DVBCHK="A":"A",1:"L")
137 I DVBCHK'="B",DVBBDT>0 S DIC("S")=$S(DVBCHK="A":"I $P(^(2),U,10)=""A""",1:"I $P(^(2),U,10)=""L""")_",$P(^(0),U,4)>(DVBBDT-.0000001),$P(^(0),U,4)<(DVBEDT+.0000001)"
138 D ^DIC
139 K DIC
140 S DVBAY=Y
141 I DVBAY<0 DO Q
142 .S VAR(1,0)="0,0,0,2:2,0^No selection made!"
143 .D WR^DVBAUTL4("VAR")
144 .K VAR
145 .D CONTMES^DVBCUTL4
146 .S DVBASTOP=1
147 .Q
148 I DVBAY>0 DO
149 .I '$$LOCK^DVBAUTL6(+DVBAY) S DVBASTOP=1 Q
150 .S (ZI,DA,DVBAIFN)=+DVBAY
151 .S DVBREQDT=$P(^DVB(396,DA,0),U,4)
152 .D ALERT^DVBAREG2(+DVBAY)
153 .D ASK^DVBAREG2
154 .Q:$D(DVBAQUIT)!($D(DVBASTOP))
155 .S ONFILE=0
156 .S DVBAENTR=+DVBAY
157 .S DVBDOC=$P(^DVB(396,DVBAENTR,2),U,10)
158 .I DVBDOC["A" S ADMNUM=$$ADM(DVBREQDT,+DFN)
159 .I STAT'="" D ALERT1^DVBAREG2
160 .I $D(DVBAQUIT) K DVBAEDT
161 .I ONFILE=1 S DVBASTOP=1 Q
162 .Q
163 K DVBAY
164 Q
165 ;
166ADM(A,B) ;This entry point will return the IEN in DGPM for the patient
167 ;and admission date given. A will be the admission date and B will
168 ;be the DFN of the patient.
169 ;
170 N X
171 S A=9999999.9999999-A
172 S X=$O(^DGPM("ATID1",+B,A,0))
173 I X DO
174 .I '$D(^DGPM(X,0)) S X=""
175 .Q
176 I X="" Q 0
177 Q X
Note: See TracBrowser for help on using the repository browser.