SDRPA07 ;BP-OIFO/ESW - APPOINTMENT BATCH TRANSMISSION BUILDER; ; 9/14/04 9:20am ; Compiled April 24, 2006 17:00:51 ; Compiled June 20, 2008 08:32:32
;;5.3;Scheduling;**290,333,349,376,446,528**;AUG 13 1993;Build 4
;
;
SNDS19(ZTSK,SDBCID,SDMCID) ;Main entry point for the sending of SIU-S19 batch messages to
; the National Patient Care Database
;
;Input : ZTSK
;Output : SDBCID - Batch Control ID
; SDMCID - Message Control ID
;
;
;Declare variables
N X,X1,X2,%H
N BATCHC,MSGN,CURLINE
N LINEN,MSHLINE,XMITERR,HL7XMIT,ERROR,ORIGENT,ORIGMNT
N HLEID,HL,HLECH,HLFS,HLQ,HLMID,HLMTIEN,HLDT,HLDT1,MSGID,HLRESLT,HLP
;Set message count limit for batch message
;Initialize global locations
S XMITERR="^TMP(""SD-PAIT-BLD"","_$J_",""ERRORS"")"
S HL7XMIT="^TMP(""HLS"","_$J_")"
K @XMITERR,@HL7XMIT
;Initiate
D INIT^HLFNC2("SD-PAIT-EVENT",.HL)
;Unable to initiate HL7 variable - send error bulletin - done
;I ($O(HL(""))="") D ERRBUL($P(HL,U,2)) Q ; create ERRBUL later
;Create batch message
D CREATE^HLTF(.HLMID,.HLMTIEN,.HLDT,.HLDT1)
;HLMID - value of batch ID
;HLMTIEN - IEN of Message Text file entry
;HLDT - current date/time in FM internal format
;HLDT1 - current date/time in HL7 format
N SDA,SDDT S SDA=HLMID,SDDT=HLDT ; to be used to file later
;Unable to create batch message - send error bulletin - done
;I ('HLMTIEN) D ERRBUL("Unable to create batch HL7 message") Q
;Initialize message count
S BATCHC=0
;Initialize message number
S MSGN=0
;Initialize line count
S LINEN=1
S CURLINE=LINEN
;Loop through list of appointments requiring transmission
N RUNID S RUNID=$O(^SDWL(409.6,"AD",ZTSK,""))
N DFN,SD25,SD6,SD8,SD7,SDPATCL S DFN="" F S DFN=$O(^TMP("SDDPT",$J,DFN)) Q:DFN="" D
.N SDP,ICN,SSN,SNM,FNM,MNM,DOB,SDSC,SDSCP,SDENRO,SDAPPT S SDP=^TMP("SDDPT",$J,DFN)
.S ICN=$P(SDP,U),SSN=$P(SDP,U,2),SNM=$P(SDP,U,3),FNM=$P(SDP,U,4)
.S MNM=$P(SDP,U,5),DOB=$P(SDP,U,6),SDSC=$P(SDP,U,7),SDSCP=$P(SDP,U,8),SDENRO=$P(SDP,U,9)
.N SDADT S SDADT="" F S SDADT=$O(^TMP("SDDPT",$J,DFN,SDADT)) Q:SDADT="" D
..N SDPT,SDCDATE,SDADID,SDSDDT,SDSTAT,SDNAVA,SDCHKOUT,SDCDT,SDARF,SDARDT,SDNEW,SDCL,SDCLNUM,SDSTOP,SDCSTOP,SDFAC,SDDAM,SDCLNM,SDSTOPD,SDCSTOPD
..N SDSTOPDD,SD8RD
..S SDPT=^TMP("SDDPT",$J,DFN,SDADT),SDADID=$P(SDPT,U),SDDAM=$P(SDPT,U,2),SDSDDT=$P(SDPT,U,3),SDNAVA=$P(SDPT,U,5)
..S SDCHKOUT=$P(SDPT,U,6),SDCDT=$P(SDPT,U,7),SDARDT=$P(SDPT,U,9),SDNEW=$P(SDPT,U,10),SDCL=$P(SDPT,U,12),SDCLNM=$P(SDPT,U,13)
..S SDSTOP=$P(SDPT,U,14),SDCSTOP=$P(SDPT,U,15),SDFAC=$P(SDPT,U,16),SDPATCL=$P(SDPT,U,4)
..S SDAPPT=^TMP("SDDPT",$J,DFN,SDADT,"SCH"),SD25=$P(SDAPPT,"^",2),SD6=$P(SDAPPT,"^",3),SD8=$P(SDAPPT,"^",4),SD8RD=$P(SDAPPT,"^",7)
..S SDSTOPDD=^TMP("SDDPT",$J,DFN,SDADT,"STDC"),SDSTOPD=$P(SDSTOPDD,"^"),SDCSTOPD=$P(SDSTOPDD,"^",2)
..;calculate consult date if applicable; 446
..N SEQ S SEQ=0,SDCDATE="" F S SEQ=$O(^SC(SDCL,"S",SDADT,1,SEQ)) Q:+SEQ'=SEQ I $P($G(^SC(SDCL,"S",SDADT,1,SEQ,0)),"^")=DFN D Q ;SD/528 added $G
...S SDCSLT=$$GET1^DIQ(44.003,SEQ_","_SDADT_","_SDCL_",",688,"I") ; consult
...Q:SDCSLT=""
...I $D(^GMR(123,SDCSLT)) S SDCDATE=$$DTCONV^SDRPA08($$GET1^DIQ(123,SDCSLT_",",3,"I")) ;date converted to HL7
..;Calculate message control ID
..S MSGN=MSGN+1
..S MSGID=HLMID_"-"_MSGN
..;Build MSG segment
..I (MSGID'="") D
...;remember orig message and event type
...S ORIGMNT="SIU"
...S ORIGENT="S12"
...S HL("MNT")="SIU",HL("ETN")=$P(SDAPPT,"^")
...;build MSH segment
...K RESULT D MSH^HLFNC2(.HL,MSGID,.RESULT)
...;reset message & event type to its orig values
...S HL("MNT")=ORIGMNT
...S HL("ETN")=ORIGENT
...;copy MSH segment into HL7 message
...S @HL7XMIT@(CURLINE)=RESULT
...N SDFACL S SDFACL=$P($$SITE^VASITE(),"^",3)
...S $P(@HL7XMIT@(CURLINE),U,4)=SDFACL ;sending facility station #
...S $P(@HL7XMIT@(CURLINE),U,5)="SD-AAC-PAIT" ;Receiving Application
...S $P(@HL7XMIT@(CURLINE),U,6)=200 ; Receiving Facility
...I ($D(RESULT(1))) D
....S @HL7XMIT@(CURLINE,1)=RESULT(1)
....S CURLINE=CURLINE+1
...E S CURLINE=CURLINE+1
..;get list of segments
..N SDSCH S SDSCH="SCH"_HLFS_1_"^^^^^"
..S SD7=SDNAVA
..;S ^TMP("HLS",$J,CURLINE)
..S @HL7XMIT@(CURLINE)=SDSCH_SD6_"^"_SD7_"^"_SD8_"^^^"
..N SDDAT S SDDAT="~~~"_SDDAM_"~~~"_"Date Appt Created|~~~"_SDSDDT_"~~~"_"Desired Date|~~~"_SDADID_"~~~"_"Appt Date"
..S SDDAT=SDDAT_"|~~~"_SDCHKOUT_"~~~"_"Checkout Date"
..S SDDAT=SDDAT_"|~~~"_SDCDT_"~~~"_"Cancellation Date"
..S SDDAT=SDDAT_"|~~~"_SDARDT_"~~~"_"Auto-rebook Date"
..S SDDAT=SDDAT_"|~~~"_SD8RD_"~~~"_"Resched Date"
..S SDDAT=SDDAT_"|~~~"_SDCDATE_"~~~"_"Consult Date"
..;S $P(SDSCH,U,12)=SDDAT,$P(SDSCH,U,26)=SDSTAT
..S @HL7XMIT@(CURLINE,1)=SDDAT_"^^^^^^^^^^^^^^"_SD25
..S CURLINE=CURLINE+1
..S @HL7XMIT@(CURLINE)=$$EN^VAFHLPID(DFN,"1,3,5,7,11,19",1,1)
..N SDCDFN S SDCDFN=$P(@HL7XMIT@(CURLINE),"^",4),SDCDFN=SDCDFN_"|"_DFN_"~~~USVHA&&L~PI" I $P(SDCDFN,"~")["V" S $P(SDCDFN,"~",2)=""
..S $P(@HL7XMIT@(CURLINE),"^",4)=SDCDFN
..N SDZIP S SDZIP=$P(@HL7XMIT@(CURLINE),U,12),SDZIP=$P(SDZIP,"~",5) S $P(@HL7XMIT@(CURLINE),U,12)="~~~~"_SDZIP
..S CURLINE=CURLINE+1
..;get Admission Type
..N SDCR1,SDAT,SDCR S SDCR1=$E(SDDAM,5,8)_$E(SDDAM,1,4) D DT^DILF(,SDCR1,.SDCR) S SDAT=$$POV^SDRPA20(DFN,SDADT,SDCL,SDCR)
..S @HL7XMIT@(CURLINE)="PV1^1^"_SDPATCL_"^^"_SDAT_"^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^"_SDFAC
..S CURLINE=CURLINE+1
..S SDNEW=$S(SDNEW=1:"NSF",SDNEW=2:"OPN",SDNEW=3:"SHB")
..S @HL7XMIT@(CURLINE)="PV2^^^^^^^^^^^^^^^^^^^^^^^^"_SDNEW
..S CURLINE=CURLINE+1
..I $D(^TMP("SDDPT",$J,DFN,SDADT,"ROL")) D
...N SDCNT,SDAIP S SDAIP="AIP^" S SDCNT="" F S SDCNT=$O(^TMP("SDDPT",$J,DFN,SDADT,"ROL",SDCNT)) Q:SDCNT="" D
....N SDPOVID,SDPROVNM,SDROLS
....S SDROLS=^TMP("SDDPT",$J,DFN,SDADT,"ROL",SDCNT)
....S SDPOVID=$P(SDROLS,U,3),SDPROVNM=$P(SDROLS,U,4),SDPROVNM=$TR(SDPROVNM,",","~")
....S SDPROVNM=$TR(SDPROVNM," ","~")
....I $L(SDPROVNM,"~")=2 S SDPROVNM=SDPROVNM_"~~"
....E I $L(SDPROVNM,"~")=3 S SDPROVNM=SDPROVNM_"~"
....S @HL7XMIT@(CURLINE)=SDAIP_SDCNT_"^^"_SDPOVID_"~"_SDPROVNM_"^"_"Provider"
....S CURLINE=CURLINE+1
..S @HL7XMIT@(CURLINE)="AIL^1^^"_SDCL_"~~~~~~~~"_SDCLNM_"^"_SDSTOP_"~"_SDSTOPD_"~DSS Clinic ID^"_SDCSTOP_"~"_SDCSTOPD_"~DSS Credit Stop"
..S CURLINE=CURLINE+1
..N SDCNT S SDCNT="" F S SDCNT=$O(^TMP("SDDPT",$J,DFN,SDADT,"ZCL",SDCNT)) Q:SDCNT="" D
...S @HL7XMIT@(CURLINE)=^TMP("SDDPT",$J,DFN,SDADT,"ZCL",SDCNT,0)
...S CURLINE=CURLINE+1
..;create ZEN only if enrollment was retrieved
..I SDENRO>0 S @HL7XMIT@(CURLINE)="ZEN^1^^^^^^^^"_SDENRO,CURLINE=CURLINE+1
..S @HL7XMIT@(CURLINE)="ZSP^1^"_SDSC_"^"_SDSCP
..S CURLINE=CURLINE+1
..;ZEL
..N SDZEL D EN1^VAFHLZEL(DFN,"1,37,38",1,.SDZEL) D
...;need to modify 37 WITH THE CREATION DATE
...N SDDAMV S SDDAMV=$$HL7TFM^XLFDT(SDDAM)
...N SDVC S SDVC=$$CVEDT^DGCV(DFN,SDDAMV),SDVC=$P(SDVC,"^",3) D
....S $P(SDZEL(1),"^",38)=$S(SDVC=1:1,SDVC=0:0,1:"U")
....I $P(SDZEL(1),"^",39)'?8N S $P(SDZEL(1),"^",39)=""
...S @HL7XMIT@(CURLINE)=SDZEL(1)
..S CURLINE=CURLINE+1
..;ZMH
..N SAR D ENTER^VAFHLZMH(DFN,"SAR","1,5,10","3,4",HL("FS"),HL("ECH"),"")
..S $P(SAR(1,0),"^",4)="" ;
..;service separation date
..;combat indication and location;gulf war indication
..S $P(SAR(1,0),"^",5)="~"_$P($P(SAR(1,0),"^",5),"~",2)
..N SS F SS=2,3 D
...S $P(SAR(SS,0),"^",5)=""
..I $E($P(SAR(2,0),"^",4))'="Y" S $P(SAR(2,0),"^",4)="N~"
..I $E($P(SAR(3,0),"^",4))'="Y" S $P(SAR(3,0),"^",4)="N"
..N SDD F SDD=1,2,3 S @HL7XMIT@(CURLINE)=SAR(SDD,0) S CURLINE=CURLINE+1
..;file MSGID into 409.69 separately as batch # and ID #
..N DIE,DA D
...S DIE="^SDWL(409.6,"_RUNID_",1,",DA(1)=RUNID
...S DA=$O(^SDWL(409.6,"AC",DFN,SDADT,RUNID,"")) D
....I $P(^SDWL(409.6,RUNID,1,DA,0),"^",3)'="" S DA=$O(^SDWL(409.6,"AC",DFN,SDADT,RUNID,DA))
...S DR="2///"_+MSGID_";3///"_$P(MSGID,"-",2) D ^DIE
D GENERATE^HLMA("SD-PAIT-EVENT","GB",1,.HLRESLT,HLMTIEN,.HLP) K @HL7XMIT
N DA,DIE,DR S DA=RUNID,DIE=409.6,DR="1.1///"_+$G(MSGID) D ^DIE
S SDMCID=+$G(SDMCID)
;file message control ID # and batch control ID number
N DIC,DA,X,Y D
.S DIC="^SDWL(409.6,"_RUNID_",2,",DA(1)=RUNID,DIC("P")=409.7,DIC(0)="X"
.S SDBCID=+$G(HLRESLT)
.K DO S X=+$G(SDBCID) D FILE^DICN
.S DA=+Y,DIE=DIC,DR=".02///"_+$G(SDDT)_";.03///"_+$G(SDA) D ^DIE
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDRPA07 8370 printed Apr 09, 2024@21:52:58 Page 2
SDRPA07 ;BP-OIFO/ESW - APPOINTMENT BATCH TRANSMISSION BUILDER; ; 9/14/04 9:20am ; Compiled April 24, 2006 17:00:51 ; Compiled June 20, 2008 08:32:32
+1 ;;5.3;Scheduling;**290,333,349,376,446,528**;AUG 13 1993;Build 4
+2 ;
+3 ;
SNDS19(ZTSK,SDBCID,SDMCID) ;Main entry point for the sending of SIU-S19 batch messages to
+1 ; the National Patient Care Database
+2 ;
+3 ;Input : ZTSK
+4 ;Output : SDBCID - Batch Control ID
+5 ; SDMCID - Message Control ID
+6 ;
+7 ;
+8 ;Declare variables
+9 NEW X,X1,X2,%H
+10 NEW BATCHC,MSGN,CURLINE
+11 NEW LINEN,MSHLINE,XMITERR,HL7XMIT,ERROR,ORIGENT,ORIGMNT
+12 NEW HLEID,HL,HLECH,HLFS,HLQ,HLMID,HLMTIEN,HLDT,HLDT1,MSGID,HLRESLT,HLP
+13 ;Set message count limit for batch message
+14 ;Initialize global locations
+15 SET XMITERR="^TMP(""SD-PAIT-BLD"","_$JOB_",""ERRORS"")"
+16 SET HL7XMIT="^TMP(""HLS"","_$JOB_")"
+17 KILL @XMITERR,@HL7XMIT
+18 ;Initiate
+19 DO INIT^HLFNC2("SD-PAIT-EVENT",.HL)
+20 ;Unable to initiate HL7 variable - send error bulletin - done
+21 ;I ($O(HL(""))="") D ERRBUL($P(HL,U,2)) Q ; create ERRBUL later
+22 ;Create batch message
+23 DO CREATE^HLTF(.HLMID,.HLMTIEN,.HLDT,.HLDT1)
+24 ;HLMID - value of batch ID
+25 ;HLMTIEN - IEN of Message Text file entry
+26 ;HLDT - current date/time in FM internal format
+27 ;HLDT1 - current date/time in HL7 format
+28 ; to be used to file later
NEW SDA,SDDT
SET SDA=HLMID
SET SDDT=HLDT
+29 ;Unable to create batch message - send error bulletin - done
+30 ;I ('HLMTIEN) D ERRBUL("Unable to create batch HL7 message") Q
+31 ;Initialize message count
+32 SET BATCHC=0
+33 ;Initialize message number
+34 SET MSGN=0
+35 ;Initialize line count
+36 SET LINEN=1
+37 SET CURLINE=LINEN
+38 ;Loop through list of appointments requiring transmission
+39 NEW RUNID
SET RUNID=$ORDER(^SDWL(409.6,"AD",ZTSK,""))
+40 NEW DFN,SD25,SD6,SD8,SD7,SDPATCL
SET DFN=""
FOR
SET DFN=$ORDER(^TMP("SDDPT",$JOB,DFN))
if DFN=""
QUIT
Begin DoDot:1
+41 NEW SDP,ICN,SSN,SNM,FNM,MNM,DOB,SDSC,SDSCP,SDENRO,SDAPPT
SET SDP=^TMP("SDDPT",$JOB,DFN)
+42 SET ICN=$PIECE(SDP,U)
SET SSN=$PIECE(SDP,U,2)
SET SNM=$PIECE(SDP,U,3)
SET FNM=$PIECE(SDP,U,4)
+43 SET MNM=$PIECE(SDP,U,5)
SET DOB=$PIECE(SDP,U,6)
SET SDSC=$PIECE(SDP,U,7)
SET SDSCP=$PIECE(SDP,U,8)
SET SDENRO=$PIECE(SDP,U,9)
+44 NEW SDADT
SET SDADT=""
FOR
SET SDADT=$ORDER(^TMP("SDDPT",$JOB,DFN,SDADT))
if SDADT=""
QUIT
Begin DoDot:2
+45 NEW SDPT,SDCDATE,SDADID,SDSDDT,SDSTAT,SDNAVA,SDCHKOUT,SDCDT,SDARF,SDARDT,SDNEW,SDCL,SDCLNUM,SDSTOP,SDCSTOP,SDFAC,SDDAM,SDCLNM,SDSTOPD,SDCSTOPD
+46 NEW SDSTOPDD,SD8RD
+47 SET SDPT=^TMP("SDDPT",$JOB,DFN,SDADT)
SET SDADID=$PIECE(SDPT,U)
SET SDDAM=$PIECE(SDPT,U,2)
SET SDSDDT=$PIECE(SDPT,U,3)
SET SDNAVA=$PIECE(SDPT,U,5)
+48 SET SDCHKOUT=$PIECE(SDPT,U,6)
SET SDCDT=$PIECE(SDPT,U,7)
SET SDARDT=$PIECE(SDPT,U,9)
SET SDNEW=$PIECE(SDPT,U,10)
SET SDCL=$PIECE(SDPT,U,12)
SET SDCLNM=$PIECE(SDPT,U,13)
+49 SET SDSTOP=$PIECE(SDPT,U,14)
SET SDCSTOP=$PIECE(SDPT,U,15)
SET SDFAC=$PIECE(SDPT,U,16)
SET SDPATCL=$PIECE(SDPT,U,4)
+50 SET SDAPPT=^TMP("SDDPT",$JOB,DFN,SDADT,"SCH")
SET SD25=$PIECE(SDAPPT,"^",2)
SET SD6=$PIECE(SDAPPT,"^",3)
SET SD8=$PIECE(SDAPPT,"^",4)
SET SD8RD=$PIECE(SDAPPT,"^",7)
+51 SET SDSTOPDD=^TMP("SDDPT",$JOB,DFN,SDADT,"STDC")
SET SDSTOPD=$PIECE(SDSTOPDD,"^")
SET SDCSTOPD=$PIECE(SDSTOPDD,"^",2)
+52 ;calculate consult date if applicable; 446
+53 ;SD/528 added $G
NEW SEQ
SET SEQ=0
SET SDCDATE=""
FOR
SET SEQ=$ORDER(^SC(SDCL,"S",SDADT,1,SEQ))
if +SEQ'=SEQ
QUIT
IF $PIECE($GET(^SC(SDCL,"S",SDADT,1,SEQ,0)),"^")=DFN
Begin DoDot:3
+54 ; consult
SET SDCSLT=$$GET1^DIQ(44.003,SEQ_","_SDADT_","_SDCL_",",688,"I")
+55 if SDCSLT=""
QUIT
+56 ;date converted to HL7
IF $DATA(^GMR(123,SDCSLT))
SET SDCDATE=$$DTCONV^SDRPA08($$GET1^DIQ(123,SDCSLT_",",3,"I"))
End DoDot:3
QUIT
+57 ;Calculate message control ID
+58 SET MSGN=MSGN+1
+59 SET MSGID=HLMID_"-"_MSGN
+60 ;Build MSG segment
+61 IF (MSGID'="")
Begin DoDot:3
+62 ;remember orig message and event type
+63 SET ORIGMNT="SIU"
+64 SET ORIGENT="S12"
+65 SET HL("MNT")="SIU"
SET HL("ETN")=$PIECE(SDAPPT,"^")
+66 ;build MSH segment
+67 KILL RESULT
DO MSH^HLFNC2(.HL,MSGID,.RESULT)
+68 ;reset message & event type to its orig values
+69 SET HL("MNT")=ORIGMNT
+70 SET HL("ETN")=ORIGENT
+71 ;copy MSH segment into HL7 message
+72 SET @HL7XMIT@(CURLINE)=RESULT
+73 NEW SDFACL
SET SDFACL=$PIECE($$SITE^VASITE(),"^",3)
+74 ;sending facility station #
SET $PIECE(@HL7XMIT@(CURLINE),U,4)=SDFACL
+75 ;Receiving Application
SET $PIECE(@HL7XMIT@(CURLINE),U,5)="SD-AAC-PAIT"
+76 ; Receiving Facility
SET $PIECE(@HL7XMIT@(CURLINE),U,6)=200
+77 IF ($DATA(RESULT(1)))
Begin DoDot:4
+78 SET @HL7XMIT@(CURLINE,1)=RESULT(1)
+79 SET CURLINE=CURLINE+1
End DoDot:4
+80 IF '$TEST
SET CURLINE=CURLINE+1
End DoDot:3
+81 ;get list of segments
+82 NEW SDSCH
SET SDSCH="SCH"_HLFS_1_"^^^^^"
+83 SET SD7=SDNAVA
+84 ;S ^TMP("HLS",$J,CURLINE)
+85 SET @HL7XMIT@(CURLINE)=SDSCH_SD6_"^"_SD7_"^"_SD8_"^^^"
+86 NEW SDDAT
SET SDDAT="~~~"_SDDAM_"~~~"_"Date Appt Created|~~~"_SDSDDT_"~~~"_"Desired Date|~~~"_SDADID_"~~~"_"Appt Date"
+87 SET SDDAT=SDDAT_"|~~~"_SDCHKOUT_"~~~"_"Checkout Date"
+88 SET SDDAT=SDDAT_"|~~~"_SDCDT_"~~~"_"Cancellation Date"
+89 SET SDDAT=SDDAT_"|~~~"_SDARDT_"~~~"_"Auto-rebook Date"
+90 SET SDDAT=SDDAT_"|~~~"_SD8RD_"~~~"_"Resched Date"
+91 SET SDDAT=SDDAT_"|~~~"_SDCDATE_"~~~"_"Consult Date"
+92 ;S $P(SDSCH,U,12)=SDDAT,$P(SDSCH,U,26)=SDSTAT
+93 SET @HL7XMIT@(CURLINE,1)=SDDAT_"^^^^^^^^^^^^^^"_SD25
+94 SET CURLINE=CURLINE+1
+95 SET @HL7XMIT@(CURLINE)=$$EN^VAFHLPID(DFN,"1,3,5,7,11,19",1,1)
+96 NEW SDCDFN
SET SDCDFN=$PIECE(@HL7XMIT@(CURLINE),"^",4)
SET SDCDFN=SDCDFN_"|"_DFN_"~~~USVHA&&L~PI"
IF $PIECE(SDCDFN,"~")["V"
SET $PIECE(SDCDFN,"~",2)=""
+97 SET $PIECE(@HL7XMIT@(CURLINE),"^",4)=SDCDFN
+98 NEW SDZIP
SET SDZIP=$PIECE(@HL7XMIT@(CURLINE),U,12)
SET SDZIP=$PIECE(SDZIP,"~",5)
SET $PIECE(@HL7XMIT@(CURLINE),U,12)="~~~~"_SDZIP
+99 SET CURLINE=CURLINE+1
+100 ;get Admission Type
+101 NEW SDCR1,SDAT,SDCR
SET SDCR1=$EXTRACT(SDDAM,5,8)_$EXTRACT(SDDAM,1,4)
DO DT^DILF(,SDCR1,.SDCR)
SET SDAT=$$POV^SDRPA20(DFN,SDADT,SDCL,SDCR)
+102 SET @HL7XMIT@(CURLINE)="PV1^1^"_SDPATCL_"^^"_SDAT_"^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^"_SDFAC
+103 SET CURLINE=CURLINE+1
+104 SET SDNEW=$SELECT(SDNEW=1:"NSF",SDNEW=2:"OPN",SDNEW=3:"SHB")
+105 SET @HL7XMIT@(CURLINE)="PV2^^^^^^^^^^^^^^^^^^^^^^^^"_SDNEW
+106 SET CURLINE=CURLINE+1
+107 IF $DATA(^TMP("SDDPT",$JOB,DFN,SDADT,"ROL"))
Begin DoDot:3
+108 NEW SDCNT,SDAIP
SET SDAIP="AIP^"
SET SDCNT=""
FOR
SET SDCNT=$ORDER(^TMP("SDDPT",$JOB,DFN,SDADT,"ROL",SDCNT))
if SDCNT=""
QUIT
Begin DoDot:4
+109 NEW SDPOVID,SDPROVNM,SDROLS
+110 SET SDROLS=^TMP("SDDPT",$JOB,DFN,SDADT,"ROL",SDCNT)
+111 SET SDPOVID=$PIECE(SDROLS,U,3)
SET SDPROVNM=$PIECE(SDROLS,U,4)
SET SDPROVNM=$TRANSLATE(SDPROVNM,",","~")
+112 SET SDPROVNM=$TRANSLATE(SDPROVNM," ","~")
+113 IF $LENGTH(SDPROVNM,"~")=2
SET SDPROVNM=SDPROVNM_"~~"
+114 IF '$TEST
IF $LENGTH(SDPROVNM,"~")=3
SET SDPROVNM=SDPROVNM_"~"
+115 SET @HL7XMIT@(CURLINE)=SDAIP_SDCNT_"^^"_SDPOVID_"~"_SDPROVNM_"^"_"Provider"
+116 SET CURLINE=CURLINE+1
End DoDot:4
End DoDot:3
+117 SET @HL7XMIT@(CURLINE)="AIL^1^^"_SDCL_"~~~~~~~~"_SDCLNM_"^"_SDSTOP_"~"_SDSTOPD_"~DSS Clinic ID^"_SDCSTOP_"~"_SDCSTOPD_"~DSS Credit Stop"
+118 SET CURLINE=CURLINE+1
+119 NEW SDCNT
SET SDCNT=""
FOR
SET SDCNT=$ORDER(^TMP("SDDPT",$JOB,DFN,SDADT,"ZCL",SDCNT))
if SDCNT=""
QUIT
Begin DoDot:3
+120 SET @HL7XMIT@(CURLINE)=^TMP("SDDPT",$JOB,DFN,SDADT,"ZCL",SDCNT,0)
+121 SET CURLINE=CURLINE+1
End DoDot:3
+122 ;create ZEN only if enrollment was retrieved
+123 IF SDENRO>0
SET @HL7XMIT@(CURLINE)="ZEN^1^^^^^^^^"_SDENRO
SET CURLINE=CURLINE+1
+124 SET @HL7XMIT@(CURLINE)="ZSP^1^"_SDSC_"^"_SDSCP
+125 SET CURLINE=CURLINE+1
+126 ;ZEL
+127 NEW SDZEL
DO EN1^VAFHLZEL(DFN,"1,37,38",1,.SDZEL)
Begin DoDot:3
+128 ;need to modify 37 WITH THE CREATION DATE
+129 NEW SDDAMV
SET SDDAMV=$$HL7TFM^XLFDT(SDDAM)
+130 NEW SDVC
SET SDVC=$$CVEDT^DGCV(DFN,SDDAMV)
SET SDVC=$PIECE(SDVC,"^",3)
Begin DoDot:4
+131 SET $PIECE(SDZEL(1),"^",38)=$SELECT(SDVC=1:1,SDVC=0:0,1:"U")
+132 IF $PIECE(SDZEL(1),"^",39)'?8N
SET $PIECE(SDZEL(1),"^",39)=""
End DoDot:4
+133 SET @HL7XMIT@(CURLINE)=SDZEL(1)
End DoDot:3
+134 SET CURLINE=CURLINE+1
+135 ;ZMH
+136 NEW SAR
DO ENTER^VAFHLZMH(DFN,"SAR","1,5,10","3,4",HL("FS"),HL("ECH"),"")
+137 ;
SET $PIECE(SAR(1,0),"^",4)=""
+138 ;service separation date
+139 ;combat indication and location;gulf war indication
+140 SET $PIECE(SAR(1,0),"^",5)="~"_$PIECE($PIECE(SAR(1,0),"^",5),"~",2)
+141 NEW SS
FOR SS=2,3
Begin DoDot:3
+142 SET $PIECE(SAR(SS,0),"^",5)=""
End DoDot:3
+143 IF $EXTRACT($PIECE(SAR(2,0),"^",4))'="Y"
SET $PIECE(SAR(2,0),"^",4)="N~"
+144 IF $EXTRACT($PIECE(SAR(3,0),"^",4))'="Y"
SET $PIECE(SAR(3,0),"^",4)="N"
+145 NEW SDD
FOR SDD=1,2,3
SET @HL7XMIT@(CURLINE)=SAR(SDD,0)
SET CURLINE=CURLINE+1
+146 ;file MSGID into 409.69 separately as batch # and ID #
+147 NEW DIE,DA
Begin DoDot:3
+148 SET DIE="^SDWL(409.6,"_RUNID_",1,"
SET DA(1)=RUNID
+149 SET DA=$ORDER(^SDWL(409.6,"AC",DFN,SDADT,RUNID,""))
Begin DoDot:4
+150 IF $PIECE(^SDWL(409.6,RUNID,1,DA,0),"^",3)'=""
SET DA=$ORDER(^SDWL(409.6,"AC",DFN,SDADT,RUNID,DA))
End DoDot:4
+151 SET DR="2///"_+MSGID_";3///"_$PIECE(MSGID,"-",2)
DO ^DIE
End DoDot:3
End DoDot:2
End DoDot:1
+152 DO GENERATE^HLMA("SD-PAIT-EVENT","GB",1,.HLRESLT,HLMTIEN,.HLP)
KILL @HL7XMIT
+153 NEW DA,DIE,DR
SET DA=RUNID
SET DIE=409.6
SET DR="1.1///"_+$GET(MSGID)
DO ^DIE
+154 SET SDMCID=+$GET(SDMCID)
+155 ;file message control ID # and batch control ID number
+156 NEW DIC,DA,X,Y
Begin DoDot:1
+157 SET DIC="^SDWL(409.6,"_RUNID_",2,"
SET DA(1)=RUNID
SET DIC("P")=409.7
SET DIC(0)="X"
+158 SET SDBCID=+$GET(HLRESLT)
+159 KILL DO
SET X=+$GET(SDBCID)
DO FILE^DICN
+160 SET DA=+Y
SET DIE=DIC
SET DR=".02///"_+$GET(SDDT)_";.03///"_+$GET(SDA)
DO ^DIE
End DoDot:1
+161 QUIT
