source: FOIAVistA/trunk/r/MENTAL_HEALTH-YS-RUCL-YI-YT/YTQHL7.m@ 1607

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

initial load of FOIAVistA 6/30/08 version
File size: 5.3 KB
Line 
1YTQHL7 ;ALB/ASF HL7 ; 10/31/07 2:39pm
2 ;;5.01;MENTAL HEALTH;**85,93**;Dec 30, 1994;Build 1
3 Q
4ACKMHA ;
5 N YSLOCAT,YSERT,YSDIV,YSACK,YSMID,YSFS,YSAD,YSMTXT,YSX,YS772,YSMSG
6 S YSACK="",YSFS=HL("FS")
7 ;get ack type
8 F X HLNEXT Q:HLQUIT'>0 D
9 . I $P(HLNODE,YSFS)="MSA" S YSACK=$P(HLNODE,YSFS,2),YSMID=$P(HLNODE,YSFS,3),YSERT=$P(HLNODE,YSFS,1,4)
10 ;get ien of 601.84 from message
11 S DIC=773,DIC(0)="MZ",X=YSMID D ^DIC K DIC
12 I Y'>0 D ERRMAIL("BAD BAD") Q ;-->out
13 S YS772=$P(Y,U,2) ;ien of message 772
14 S X=$$GET1^DIQ(772,YS772_",",200,,"YSMSG")
15 S N=0,YSAD=0 F S N=$O(YSMSG(N)) Q:N'>0!(YSAD>0) S YSOUT=YSMSG(N) S:$P(YSOUT,YSFS)="OBX" YSAD=+$P(YSOUT,YSFS,4)
16 I YSAD'>0 D ERRMAIL(YSMTXT_" MH ADMINITRATION #601.84 ien is 0",YSAD) Q ;--->out
17 ;set 601.84 fields
18 S YSX=$S(YSACK="AA":"S",YSACK="AE":"E",YSACK="AR":"E",1:"")
19 S DA=YSAD,DIE="^YTT(601.84,",DR="11///"_YSX_";12///NOW" D ^DIE
20 I YSX'="S" D ERRMAIL(YSERT,YSAD)
21 Q
22ERRMAIL(X,YSAD) ;mail error reports
23 N XMDUZ,XMSUB,XMTEXT,XMY,YSMAILG
24 S YSMAILG=$$GETAPP^HLCS2("YS MHA")
25 K ^TMP("YSMHAHL7",$J)
26 S ^TMP("YSMHAHL7",$J,1,0)="An attempt to send MHA3 Administration ien #"_YSAD
27 S ^TMP("YSMHAHL7",$J,2,0)="generated an error."
28 S ^TMP("YSMHAHL7",$J,3,0)="Error: "_X
29 S ^TMP("YSMHAHL7",$J,4,0)="Please report this error via official channels."
30 S XMSUB="Mental Health Assistant 3 HL7 Error"
31 S XMY("G."_$P(YSMAILG,U))=""
32 S XMTEXT="^TMP(""YSMHAHL7"",$J,"
33 S XMDUZ="AUTOMATED MESSAGE"
34 D ^XMD
35 K ^TMP("YSMHAHL7",$J)
36 Q
37HL7(YSDATA,YS) ;RPC entry
38 ;input:ADMIN = ADMINISTRATION #
39 ;output: [DATA]
40 N G,G1,N,YSAD,YSQ,CNT,MC,HLFS,HLCS,DA,DFN,DIE,DR,HLECH,HLNEXT,HLNODE,HLQUIT,MYOPTNS,MYRESULT
41 N VADMVT,VAINDT,X1,Y,YSANSID,YSAVED,YSCC,YSCONID,YSEQ,YSIN,YSIO,YSLINE,YSORBY,YSOUT,YSQN,YSTEST,YSTESTN,YSTS,YSTST
42 S YSAD=$G(YS("AD"))
43 I YSAD'?1N.N S YSDATA(1)="[ERROR]",YSDATA(2)="bad ad num" Q ;-->out
44 I '$D(^YTT(601.84,YSAD)) S YSDATA(1)="[ERROR]",YSDATA(2)="no such reference" Q ;-->out
45 ;No Dups
46 I $P($G(^YTT(601.84,YSAD,2)),U)="S" S YSDATA(1)="[ERROR]",YSDATA(2)=YSAD_" is dup" Q ;-->out
47 S YSTST=$P(^YTT(601.84,YSAD,0),U,3) ;ins ien
48 I $P($G(^YTT(601.71,YSTST,8)),U,4)'="Y" S YSDATA="[DATA]",YSDATA(2)="ins not to be sent" Q ;--> out
49 S YSDATA(1)="[ERROR]"
50 S DA=YSAD,DIE="^YTT(601.84,",DR="11///T;12///NOW" D ^DIE
51 D ADSEND
52 Q
53ADSEND ;send completed Admin to MHSHG
54 S DFN=$P(^YTT(601.84,YSAD,0),U,2)
55 S YSAVED=$P(^YTT(601.84,YSAD,0),U,4) ;changed to GIVEN 10/31/07
56 S YSTESTN=$P(^YTT(601.84,YSAD,0),U,3)
57 S YSTEST=$$GET1^DIQ(601.71,YSTESTN_",",.01)
58 S YSORBY=$P(^YTT(601.84,YSAD,0),U,6)
59 S YSLOCAT=$P(^YTT(601.84,YSAD,0),U,11)
60 S YSDIV="" S:YSLOCAT?1N.N YSDIV=$$GET1^DIQ(44,YSLOCAT_",",3.5)
61 I YSDIV=""&($D(DUZ(2))) S YSDIV=$$GET1^DIQ(4,DUZ(2)_",",.01)
62BLDM ;BUILD A SINGLE MESSAGE
63 ;MSH-EVN-PID-PV1-OBX
64 K HLA,HLEVN
65 N CNT,MC,HLFS,HLCS
66 S CNT=0
671 ;set up environment for message
68 K HL D INIT^HLFNC2("YS MHA A08 EVENT",.HL)
69 I $G(HL) D Q ; error occurred -->out
70 . ; put error handler here for init failure
71 . S YSDATA(1)="[ERROR]",YSDATA(2)="init Error: "_$P(HL,2) W !,"XXX"
72 S HLFS=$G(HL("FS")) I HLFS="" S HLFS="^"
73 S HLCS=$E(HL("ECH"),1)
742 ;Add message txt to HLA array
75 ;create ENV segment
76 S CNT=CNT+1,HLA("HLS",CNT)="EVN"_HLFS_"A08"_HLFS_$$HLDATE^HLFNC(YSAVED,"TS")_HLFS_$$HLDATE^HLFNC(YSAVED,"TS")_HLFS_"05"_HLFS_HLFS_$$HLDATE^HLFNC(YSAVED,"TS")
77 ; create PID segment for patient DFN -- call segment generator
78 S CNT=CNT+1,HLA("HLS",CNT)=$$EN^VAFHLPID(DFN,"1,2,4,6,7,8,10,11,12,13,16,17,19,22",1,1)
79 ;create PV1 segment
80 S VAINDT=YSAVED D ADM^VADPT2 S YSIO=$S(VADMVT>0:"I",1:"O")
81 S CNT=CNT+1,HLA("HLS",CNT)="PV1"_HLFS_"0001"_HLFS_YSIO_HLFS_"~~~~~~~~"_YSDIV
82 ;create OBX segments
83 D OBX(YSAD)
84 ;crete PR1 proccedure
85 S CNT=CNT+1
86 S HLA("HLS",CNT)="PR1"_HLFS_1_HLFS_HLFS_YSTESTN_$E($G(HLECH))_YSTEST_HLFS_HLFS_$$HLDATE^HLFNC(YSAVED,"TS")_HLFS_"D"
87 N DGNAME S DGNAME("FILE")=200,DGNAME("IENS")=YSORBY,DGNAME("FIELD")=.01
88 S X1=$$HLNAME^XLFNAME(.DGNAME,"S",$E($G(HLECH))),X1=YSORBY_$E(HLECH,1)_X1
89 S HLA("HLS",CNT)=HLA("HLS",CNT)_HLFS_HLFS_HLFS_HLFS_HLFS_HLFS_X1
90 ;
91 ;
92DIRECT ;CALL HL7 TO TRANSMIT MESSAGE
93 ; VM/RJT - YS*5.01*93 - Turn off message generation
94 ;D GENERATE^HLMA("YS MHA A08 EVENT","LM",1,.MYRESULT,"",.MYOPTNS)
95 S YSDATA(1)="[DATA]"
96 Q
97OBX(YSAD) ;enter multiple OBX seqments
98 S YSIN=$P(^YTT(601.84,YSAD,0),U,3)
99 S YSEQ=0 F S YSEQ=$O(^YTT(601.76,"AD",YSIN,YSEQ)) Q:YSEQ'>0 S YSCONID=$O(^YTT(601.76,"AD",YSIN,YSEQ,0)) D
100 . S YSQN=$P(^YTT(601.76,YSCONID,0),U,4)
101 . S YSANSID=$O(^YTT(601.85,"AC",YSAD,YSQN,0))
102 . Q:YSANSID'?1N.N
103 . S G=$G(^YTT(601.85,YSANSID,0)),YSCC=$P(G,U,4)
104 . S CNT=CNT+1
105 . I +YSCC S CNT=CNT+1,HLA("HLS",CNT)="OBX"_HLFS_YSEQ_HLFS_"CE"_HLFS_YSAD_"~~~"_YSQN_HLFS_1_HLFS_YSCC_"~"_$G(^YTT(601.75,$P(G,U,4),1))_"||||||"_"R|||"_$$HLDATE^HLFNC(YSAVED,"TS") Q
106 . E S YSLINE=0 F S YSLINE=$O(^YTT(601.85,YSANSID,1,YSLINE)) Q:YSLINE'>0 D
107 .. S CNT=CNT+1,HLA("HLS",CNT)="OBX"_HLFS_YSEQ_HLFS_"CE"_HLFS_YSAD_"~~~"_YSQN_HLFS_YSLINE_HLFS_0_"~"_$G(^YTT(601.85,YSANSID,1,YSLINE,0))_"||||||"_"R|||"_$$HLDATE^HLFNC(YSAVED,"TS") Q
108 Q
109REDO ;resend all no transmits and errors
110 S YSAD=0 F S YSAD=$O(^YTT(601.84,YSAD)) Q:YSAD'>0 D
111 . S YSTS=$P($G(^YTT(601.84,YSAD,2)),U)
112 . I (YSTS="T")!(YSTS="E") K YS,YSDATA S YS("AD")=YSAD D HL7(.YSDATA,.YS)
113 Q
114REDO1 ;resend single admin
115 K DIC,DIR S DIC(0)="AEQM",DIC="^YTT(601.84," D ^DIC Q:Y'>0 ;-->out
116 W !
117 S (YSAD,DA)=+Y D EN^DIQ
118 S DIR(0)="Y",DIR("A")="Send HL7",DIR("B")="No" D ^DIR
119 I Y K YS,YSDATA S YS("AD")=YSAD D HL7(.YSDATA,.YS)
120 G REDO1
Note: See TracBrowser for help on using the repository browser.