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