- 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 Feb 19, 2025@00:26:47 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