source: WorldVistAEHR/trunk/r/HINQ-DVB--DVBA--DVBE--DVBC/DVBHIQM.m

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

initial load of WorldVistAEHR

File size: 4.1 KB
Line 
1DVBHIQM ;ISC-ALBANY/PKE,DLM,PHH/WASH-MAIL DELIVERY PROGRAM ; 3/23/06 7:41am
2 ;;4.0;HINQ;**49,57**;03/25/92
3 G EN
4LIN Q:CT>50 S CT=CT+1,A1=A_CT_",0)",@A1=T1 Q
5DD S:Y Y=$S($E(Y,4,5):$P("JAN^FEB^MAR^APR^MAY^JUN^JUL^AUG^SEP^OCT^NOV^DEC","^",+$E(Y,4,5))_" ",1:"")_$S($E(Y,6,7):+$E(Y,6,7)_",",1:"")_($E(Y,1,3)+1700)_$P("@"_$E(Y_0,9,10)_":"_$E(Y_"000",11,12),"^",Y[".") Q
6 ;
7EN I $D(X(1)),$E(X(1),1,5)'="ERROR" S DFN=$E(X(1),8,21),XMDUZ=.5,XMSUB="HINQ response for " I DFN?14"0" S DFN=0,XMSUB="HINQ Transaction Test "
8 I DFN'?14" " K DVBREQST
9 S DFN=+DFN I $D(DUZ) S XMORIG=DUZ
10 E QUIT
11 I '+XMORIG QUIT
12 ;
13 S (DVBASK,DVBASKER)=0
14 I DFN=0 G SUBJ
15 ;
16MAILGP K XMY,DVBXMY
17 I $D(^XMB(3.8,"B","DVBHINQ")) S N=0,N=$O(^("DVBHINQ",N)) Q:'N F DVBU=0:0 S DVBU=$O(^XMB(3.8,N,1,"B",DVBU)) Q:'DVBU S XMY(DVBU)=""
18REQ ;
19 ;replace direct global lookup of div with GETS^DIQ - DVB*4*49
20 I $D(^DVB(395.5,DFN,0)) D
21 . N DVBARR,DVBERR
22 . D GETS^DIQ(395.5,DFN_",",9,"E","DVBARR","DVBERR")
23 . S DVBDIV=$G(DVBARR(395.5,DFN_",",9,"E"))
24 F DVBU=0:0 S DVBU=$O(^DVB(395.5,DFN,1,DVBU)) Q:'DVBU S:$D(^(DVBU,0)) DVBXMY(DVBU)=$P(^(0),U,2) ;for latest requestor dvbasker
25 I '$D(DVBDIV) K DVBDIV
26 ;
27 F DVBU=0:0 S DVBU=$O(DVBXMY(DVBU)) Q:'DVBU I $D(^XUSEC("DVBHINQ",DVBU)) S XMY(DVBU)="" I DVBXMY(DVBU)>DVBASK S DVBASK=DVBXMY(DVBU),DVBASKER=DVBU
28 ;
29SUBJ S U="^",XMY(XMORIG)="",XMSUB=XMSUB_$S($D(^DPT(DFN,0)):$P(^(0),"^",1),1:" ")_" /requested by "_$S(DVBASKER:$S($D(^VA(200,DVBASKER,0)):$P(^(0),U),1:""),1:"")_$S('DVBASKER:$S($D(^VA(200,DUZ,0)):$P(^(0),U),1:""),1:"")
30 ;
31 K ^TMP($J) S CT=0,(A,XMTEXT)="^TMP($J,",BL="",$P(BL," ",36)=" "
32 ;
33 I $D(DVBREQST) S Y=DVBREQST D DATA,LIN,SEGM S T1="" D LIN
34 ;
35 I $D(^DPT(DFN,0)) D DPT,LIN,WARN,SEGM
36 ;
37 K DVBDIV,DVBREQST,DVBASK,DVBASKER,T9,L1,F1,F2,F3,F3,F4,F5,Y,S,S1,C,DVBXMY,DVBU,N
38 ;exit point for errors
39 I $D(DVBERR) S T1=" HINQ Error = "_DVBERR D LIN
40 I $D(DVBERR) D ERR1
41 I $D(DVBERR1) S T1=" Inquiry Data Submitted = "_DVBERR1 D LIN G ERR^DVBHQM3
42 I $D(DVBOTM),$D(DVBNETER) S Y=DVBOTM D DD S T1=" Message out Time => "_Y D LIN
43 I $D(DVBNETER) S T1=" IDCU Network Error" D LIN S T1=" "_DVBNETER D LIN I $D(DVBREQUE) S Y=DVBREQUE D DD S T1=" "_"Request has been retransmitted"_$S($L(DVBREQUE):" at "_Y,1:"") D LIN G ERR^DVBHQM3
44 I $D(DVBNETER),'$D(DVBREQUE) S T1=" Request NOT retransmitted" D LIN G ERR^DVBHQM3
45 S:X(1)["HINQ" X(1)=$E(X(1),1,6) S:$D(X(2)) X(2)=$E(X(2),1,6)
46 ;
47 G:$D(DVBABREV) EN^DVBHQM4
48 G EN^DVBHQM1
49 ;
50DPT S (S,C,T9)=""
51 S T1=$P(^DPT(DFN,0),U),Y=$P(^(0),U,3),T9=$P(^(0),U,9) D DD S T1=T1_" "_Y_" SSN:"_T9 S:$D(^(.31)) C=$P(^(.31),U,3) S:$D(^(.32)) S=$P(^(.32),U,8) S T1=T1_$S($L(C):" C-#:"_C,1:"")_$S($L(S):" S-#:"_S,1:"")_$S($D(DVBDIV):" Div:"_DVBDIV,1:"") Q
52 ;
53WARN Q:$D(DVBABREV) ;don't compare multiple values for abrev return
54 I $L(T9),$D(DVBSSN),DVBSSN?9N,+DVBSSN'=+T9 S T1="*** SSN from patient file does not match SSN from VBA ***" D LIN
55 I $L(C),$D(DVBCN),+DVBCN'=+C S T1="*** C-# from patient file does not match C-# from VBA ***" D LIN
56 I $L(S),$D(DVBSN)>9 S S1=1 F N=0:0 S N=$O(DVBSN(N)) Q:'N I +DVBSN(N)=+S K S1 Q
57 I $D(S1) S T1="*** S-# from Patient file does not match a S-# from VBA ***" D LIN
58 Q
59 ;
60SEGM Q:'$D(DVBBAS(2))
61 I '$P(DVBBAS(2),U,35),'$P(DVBBAS(2),U,36),'$P(DVBBAS(2),U,37),'$P(DVBBAS(2),U,38) Q
62 S T1=" WARNING: Error Indicators for " F N=38:-1:35 I $P(DVBBAS(2),U,N) S T1=T1_" "_$S(N=38:"BASIC",N=37:"STATISTICAL",N=36:"DIAGNOSTIC",N=35:"FUTURE",1:"")_","
63 S T1=$E(T1,1,$L(T1)-1) D LIN
64 Q
65 ;
66DATA S F1=$F(Y,"NM"),F2=$F(Y,"/",F1),F3=$F(Y,"SS",F2),F4=$F(Y,"CN",F2),F5=$F(Y,"SN",F2),T1=" Data Requested:"_$S(F1:" "_$E(Y,3,F2-2),1:"")_$S(F3:" SS# "_$E(Y,F3,F3+8),1:"")_$S(F4:" C# "_$E(Y,F4,F4+8),1:"")_$S(F5:" S# "_$E(Y,F5,F5+8),1:"") Q
67ERR1 ;set inquiry info into error text
68 N DVBZZ,DVBZZZ
69 S DVBZZZ=""
70 S DVBZZ=$S($G(DVBZ)]"":DVBZ,$G(DVBZ0)]"":DVBZ0,$G(DVBZ1)]"":DVBZ1,1:"")
71 ;DVB*4*54 - strip password from string before creating err msg- ERC
72 I $G(DVBZZ)]"",$E(DVBZZ,$L(DVBZZ)-3,$L(DVBZZ))?4U S DVBZZ=$E(DVBZZ,1,$L(DVBZZ)-4)
73 I DVBZZ["SS" S DVBZZZ="SS"_$E($P(DVBZZ,"SS",2),1,9)
74 I DVBZZ["CN" S DVBZZZ=DVBZZZ_" CN"_$E($P(DVBZZ,"CN",2),1,9)
75 I DVBZZ["SN" S DVBZZZ=DVBZZZ_" SN"_$E($P(DVBZZ,"SN",2),1,9)
76 I $G(DVBZZZ)]"" S DVBERR1=DVBZZZ
77 Q
Note: See TracBrowser for help on using the repository browser.