Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: YTQHL7

YTQHL7.m

Go to the documentation of this file.
  1. YTQHL7 ;ALB/ASF - HL7 ; 3/9/12 1:06pm
  1. ;;5.01;MENTAL HEALTH;**85,93,97,106**;Dec 30, 1994;Build 10
  1. ;Reference to VADPT supported by IA #10061
  1. ;Reference to %ZTLOAD supported by IA #10063
  1. ;Reference to XMD supported by IA #10070
  1. ;Reference to HLCS2 supported by IA #2887
  1. ;Reference to HLFNC supported by IA #10106
  1. ;Reference to HLFNC2 supported by IA #2161
  1. ;Reference to HLMA supported by IA #2164
  1. ;Reference to VAFHLPID supported by IA #263
  1. ;Reference to XLFNAME supported by IA #3065
  1. ;Reference to FILE 4 fields supported by DBIA #10090
  1. ;Reference to FILE 44 fields supported by DBIA #10040
  1. Q
  1. ACKMHA ;
  1. N YSLOCAT,YSERT,YSDIV,YSACK,YSMID,YSFS,YSAD,YSMTXT,YSX,YS772,YSMSG
  1. S YSACK="",YSFS=HL("FS")
  1. ;get ack type
  1. F X HLNEXT Q:HLQUIT'>0 D
  1. . I $P(HLNODE,YSFS)="MSA" S YSACK=$P(HLNODE,YSFS,2),YSMID=$P(HLNODE,YSFS,3),YSERT=$P(HLNODE,YSFS,1,4)
  1. ;get ien of 601.84 from message
  1. S DIC=773,DIC(0)="MZ",X=YSMID D ^DIC K DIC
  1. I Y'>0 D ERRMAIL("BAD BAD") Q ;-->out
  1. S YS772=$P(Y,U,2) ;ien of message 772
  1. S X=$$GET1^DIQ(772,YS772_",",200,,"YSMSG")
  1. 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)
  1. I YSAD'>0 D ERRMAIL("ERROR? MH ADMINITRATION #601.84 ien is 0",YSAD) Q ;--->out
  1. ;set 601.84 fields
  1. S YSX=$S(YSACK="AA":"S",YSACK="AE":"E",YSACK="AR":"E",1:"")
  1. S DA=YSAD,DIE="^YTT(601.84,",DR="11///"_YSX_";12///NOW" D ^DIE
  1. I YSACK="AR" D ARSEND Q ;resend HL7 and --> out ASF 5/14/08
  1. I YSX'="S" D ERRMAIL(YSERT,YSAD)
  1. Q
  1. ARSEND ;resend AR acks
  1. N ZTIO,ZTDESC,ZTRTN,ZTREQ,ZTDTH
  1. S ZTSAVE("YSAD")=""
  1. S ZTIO="",ZTRTN="ARHL7^YTQHL7"
  1. S %DT="FRPS",X="NOW+1H" D ^%DT S ZTDTH=Y
  1. S ZTDESC="mha3 AR HL7 resend of "_YSAD
  1. D ^%ZTLOAD
  1. Q
  1. ARHL7 ;taskman hl7 resend
  1. K YS,YSDATA
  1. S YS("AD")=YSAD
  1. D HL7^YTQHL7(.YSDATA,.YS)
  1. S ZTREQ="@"
  1. Q
  1. ERRMAIL(X,YSAD) ;mail error reports
  1. N XMDUZ,XMSUB,XMTEXT,XMY,YSMAILG
  1. S YSMAILG=$$GETAPP^HLCS2("YS MHA")
  1. K ^TMP("YSMHAHL7",$J)
  1. S ^TMP("YSMHAHL7",$J,1,0)="An attempt to send MHA3 Administration ien #"_YSAD
  1. S ^TMP("YSMHAHL7",$J,2,0)="generated an error."
  1. S ^TMP("YSMHAHL7",$J,3,0)="Error: "_X
  1. S ^TMP("YSMHAHL7",$J,4,0)="Please report this error mailto:hl7err@mentalhealth.domain.ext"
  1. S XMSUB="Mental Health Assistant 3 HL7 Error"
  1. S XMY("G."_$P(YSMAILG,U))=""
  1. S XMTEXT="^TMP(""YSMHAHL7"",$J,"
  1. S XMDUZ="AUTOMATED MESSAGE"
  1. D ^XMD
  1. K ^TMP("YSMHAHL7",$J)
  1. Q
  1. HL7(YSDATA,YS) ;RPC entry
  1. ;input:ADMIN = ADMINISTRATION #
  1. ;output: [DATA]
  1. N G,G1,N,YSAD,YSQ,CNT,MC,HLFS,HLCS,DA,DFN,DIE,DR,HLECH,HLNEXT,HLNODE,HLQUIT,MYOPTNS,MYRESULT,J1,J2
  1. N VADMVT,VAINDT,X1,Y,YSANSID,YSAVED,YSCC,YSCONID,YSEQ,YSIN,YSIO,YSLINE,YSORBY,YSOUT,YSQN,YSTEST,YSTESTN,YSTS,YSTST,YSRTYP,YSRTYPN
  1. S YSDATA(1)="[DATA]" Q ;ASF 10/13/11 Stop all HL7 messages
  1. S YSAD=$G(YS("AD"))
  1. I YSAD'?1N.N S YSDATA(1)="[ERROR]",YSDATA(2)="bad ad num" Q ;-->out
  1. I '$D(^YTT(601.84,YSAD)) S YSDATA(1)="[ERROR]",YSDATA(2)="no such reference" Q ;-->out
  1. ;No Dups
  1. I $P($G(^YTT(601.84,YSAD,2)),U)="S" S YSDATA(1)="[ERROR]",YSDATA(2)=YSAD_" is dup" Q ;-->out
  1. S YSTST=$P(^YTT(601.84,YSAD,0),U,3) ;ins ien
  1. I $P($G(^YTT(601.71,YSTST,8)),U,4)'="Y" S YSDATA(1)="[DATA]",YSDATA(2)="ins not to be sent" Q ;--> out
  1. S YSDATA(1)="[ERROR]"
  1. S DA=YSAD,DIE="^YTT(601.84,",DR="11///T;12///NOW" D ^DIE
  1. D ADSEND
  1. Q
  1. ADSEND ;send completed Admin to MHSHG
  1. S DFN=$P(^YTT(601.84,YSAD,0),U,2)
  1. S YSAVED=$P(^YTT(601.84,YSAD,0),U,4) ;changed to GIVEN 10/31/07
  1. S YSTESTN=$P(^YTT(601.84,YSAD,0),U,3)
  1. S YSTEST=$$GET1^DIQ(601.71,YSTESTN_",",.01)
  1. S YSORBY=$P(^YTT(601.84,YSAD,0),U,6)
  1. S YSLOCAT=$P(^YTT(601.84,YSAD,0),U,11)
  1. S YSDIV="" S:YSLOCAT?1N.N YSDIV=$$GET1^DIQ(44,YSLOCAT_",",3.5)
  1. I YSDIV=""&($D(DUZ(2))) S YSDIV=$$GET1^DIQ(4,DUZ(2)_",",.01)
  1. BLDM ;BUILD A SINGLE MESSAGE
  1. ;MSH-EVN-PID-PV1-OBX
  1. K HLA,HLEVN
  1. N CNT,MC,HLFS,HLCS
  1. S CNT=0
  1. 1 ;set up environment for message
  1. K HL D INIT^HLFNC2("YS MHA A08 EVENT",.HL)
  1. I $G(HL) D Q ; error occurred -->out
  1. . ; put error handler here for init failure
  1. . S YSDATA(1)="[ERROR]",YSDATA(2)="init Error: "_$P(HL,2) W !,"XXX"
  1. S HLFS=$G(HL("FS")) I HLFS="" S HLFS="^"
  1. S HLCS=$E(HL("ECH"),1)
  1. 2 ;Add message txt to HLA array
  1. ;create ENV segment
  1. 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")
  1. ; create PID segment for patient DFN -- call segment generator
  1. 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)
  1. ;create PV1 segment
  1. S VAINDT=YSAVED D ADM^VADPT2 S YSIO=$S(VADMVT>0:"I",1:"O")
  1. S CNT=CNT+1,HLA("HLS",CNT)="PV1"_HLFS_"0001"_HLFS_YSIO_HLFS_"~~~~~~~~"_YSDIV
  1. ;create OBX segments
  1. D OBX(YSAD)
  1. ;crete PR1 proccedure
  1. S CNT=CNT+1
  1. S HLA("HLS",CNT)="PR1"_HLFS_1_HLFS_HLFS_YSTESTN_$E($G(HLECH))_YSTEST_HLFS_HLFS_$$HLDATE^HLFNC(YSAVED,"TS")_HLFS_"D"
  1. N DGNAME S DGNAME("FILE")=200,DGNAME("IENS")=YSORBY,DGNAME("FIELD")=.01
  1. S X1=$$HLNAME^XLFNAME(.DGNAME,"S",$E($G(HLECH))),X1=YSORBY_$E(HLECH,1)_X1
  1. S HLA("HLS",CNT)=HLA("HLS",CNT)_HLFS_HLFS_HLFS_HLFS_HLFS_HLFS_X1
  1. CTRL ;remove stray chars
  1. F J1=1:1:CNT D:$G(HLA("HLS",J1))?.E1C.E CTRL1
  1. ;
  1. DIRECT ;CALL HL7 TO TRANSMIT MESSAGE
  1. D GENERATE^HLMA("YS MHA A08 EVENT","LM",1,.MYRESULT,"",.MYOPTNS)
  1. S YSDATA(1)="[DATA]"
  1. Q
  1. OBX(YSAD) ;enter multiple OBX seqments
  1. S YSIN=$P(^YTT(601.84,YSAD,0),U,3)
  1. 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
  1. . S YSQN=$P(^YTT(601.76,YSCONID,0),U,4)
  1. . S YSRTYP=$P($G(^YTT(601.72,YSQN,2)),U,2)
  1. . S YSRTYPN=YSRTYP*(-1)
  1. . S YSANSID=$O(^YTT(601.85,"AC",YSAD,YSQN,0))
  1. . Q:YSANSID'?1N.N
  1. . S G=$G(^YTT(601.85,YSANSID,0)),YSCC=$P(G,U,4)
  1. . S CNT=CNT+1
  1. . 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
  1. . E S YSLINE=0 F S YSLINE=$O(^YTT(601.85,YSANSID,1,YSLINE)) Q:YSLINE'>0 D
  1. .. S CNT=CNT+1,HLA("HLS",CNT)="OBX"_HLFS_YSEQ_HLFS_"CE"_HLFS_YSAD_"~~~"_YSQN_HLFS_YSLINE_HLFS_YSRTYPN_"~"
  1. .. S Y1=$G(^YTT(601.85,YSANSID,1,YSLINE,0))
  1. .. F X1="|","~" S X=$S(X1="~":":;",1:";:") F %=0:0 S %=$F(Y1,X1,%) Q:%<2 S Y1=$E(Y1,1,%-$L(X1)-1)_X_$E(Y1,%,999)
  1. .. S HLA("HLS",CNT)=HLA("HLS",CNT)_Y1_"||||||"_"R|||"_$$HLDATE^HLFNC(YSAVED,"TS") Q
  1. Q
  1. REDO ;resend all no transmits and errors
  1. S YSAD=0 F S YSAD=$O(^YTT(601.84,YSAD)) Q:YSAD'>0 D
  1. . S YSTS=$P($G(^YTT(601.84,YSAD,2)),U)
  1. . I (YSTS="T")!(YSTS="E") K YS,YSDATA S YS("AD")=YSAD D HL7(.YSDATA,.YS)
  1. Q
  1. REDO1 ;resend single admin
  1. K DIC,DIR S DIC(0)="AEQM",DIC="^YTT(601.84," D ^DIC Q:Y'>0 ;-->out
  1. W !
  1. S (YSAD,DA)=+Y D EN^DIQ
  1. S DIR(0)="Y",DIR("A")="Send HL7",DIR("B")="No" D ^DIR
  1. I Y K YS,YSDATA S YS("AD")=YSAD D HL7(.YSDATA,.YS)
  1. G REDO1
  1. CTRL1 ;remove control chars
  1. F J2=1:1 Q:HLA("HLS",J1)'?.E1C.E S:$E(HLA("HLS",J1),J2)?1C HLA("HLS",J1)=$E(HLA("HLS",J1),0,J2-1)_$E(HLA("HLS",J1),J2+1,999),J2=J2-1
  1. Q