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

SDRPA07.m

Go to the documentation of this file.
  1. 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
  1. ;
  1. ;
  1. SNDS19(ZTSK,SDBCID,SDMCID) ;Main entry point for the sending of SIU-S19 batch messages to
  1. ; the National Patient Care Database
  1. ;
  1. ;Input : ZTSK
  1. ;Output : SDBCID - Batch Control ID
  1. ; SDMCID - Message Control ID
  1. ;
  1. ;
  1. ;Declare variables
  1. N X,X1,X2,%H
  1. N BATCHC,MSGN,CURLINE
  1. N LINEN,MSHLINE,XMITERR,HL7XMIT,ERROR,ORIGENT,ORIGMNT
  1. N HLEID,HL,HLECH,HLFS,HLQ,HLMID,HLMTIEN,HLDT,HLDT1,MSGID,HLRESLT,HLP
  1. ;Set message count limit for batch message
  1. ;Initialize global locations
  1. S XMITERR="^TMP(""SD-PAIT-BLD"","_$J_",""ERRORS"")"
  1. S HL7XMIT="^TMP(""HLS"","_$J_")"
  1. K @XMITERR,@HL7XMIT
  1. ;Initiate
  1. D INIT^HLFNC2("SD-PAIT-EVENT",.HL)
  1. ;Unable to initiate HL7 variable - send error bulletin - done
  1. ;I ($O(HL(""))="") D ERRBUL($P(HL,U,2)) Q ; create ERRBUL later
  1. ;Create batch message
  1. D CREATE^HLTF(.HLMID,.HLMTIEN,.HLDT,.HLDT1)
  1. ;HLMID - value of batch ID
  1. ;HLMTIEN - IEN of Message Text file entry
  1. ;HLDT - current date/time in FM internal format
  1. ;HLDT1 - current date/time in HL7 format
  1. N SDA,SDDT S SDA=HLMID,SDDT=HLDT ; to be used to file later
  1. ;Unable to create batch message - send error bulletin - done
  1. ;I ('HLMTIEN) D ERRBUL("Unable to create batch HL7 message") Q
  1. ;Initialize message count
  1. S BATCHC=0
  1. ;Initialize message number
  1. S MSGN=0
  1. ;Initialize line count
  1. S LINEN=1
  1. S CURLINE=LINEN
  1. ;Loop through list of appointments requiring transmission
  1. N RUNID S RUNID=$O(^SDWL(409.6,"AD",ZTSK,""))
  1. N DFN,SD25,SD6,SD8,SD7,SDPATCL S DFN="" F S DFN=$O(^TMP("SDDPT",$J,DFN)) Q:DFN="" D
  1. .N SDP,ICN,SSN,SNM,FNM,MNM,DOB,SDSC,SDSCP,SDENRO,SDAPPT S SDP=^TMP("SDDPT",$J,DFN)
  1. .S ICN=$P(SDP,U),SSN=$P(SDP,U,2),SNM=$P(SDP,U,3),FNM=$P(SDP,U,4)
  1. .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)
  1. .N SDADT S SDADT="" F S SDADT=$O(^TMP("SDDPT",$J,DFN,SDADT)) Q:SDADT="" D
  1. ..N SDPT,SDCDATE,SDADID,SDSDDT,SDSTAT,SDNAVA,SDCHKOUT,SDCDT,SDARF,SDARDT,SDNEW,SDCL,SDCLNUM,SDSTOP,SDCSTOP,SDFAC,SDDAM,SDCLNM,SDSTOPD,SDCSTOPD
  1. ..N SDSTOPDD,SD8RD
  1. ..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)
  1. ..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)
  1. ..S SDSTOP=$P(SDPT,U,14),SDCSTOP=$P(SDPT,U,15),SDFAC=$P(SDPT,U,16),SDPATCL=$P(SDPT,U,4)
  1. ..S SDAPPT=^TMP("SDDPT",$J,DFN,SDADT,"SCH"),SD25=$P(SDAPPT,"^",2),SD6=$P(SDAPPT,"^",3),SD8=$P(SDAPPT,"^",4),SD8RD=$P(SDAPPT,"^",7)
  1. ..S SDSTOPDD=^TMP("SDDPT",$J,DFN,SDADT,"STDC"),SDSTOPD=$P(SDSTOPDD,"^"),SDCSTOPD=$P(SDSTOPDD,"^",2)
  1. ..;calculate consult date if applicable; 446
  1. ..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
  1. ...S SDCSLT=$$GET1^DIQ(44.003,SEQ_","_SDADT_","_SDCL_",",688,"I") ; consult
  1. ...Q:SDCSLT=""
  1. ...I $D(^GMR(123,SDCSLT)) S SDCDATE=$$DTCONV^SDRPA08($$GET1^DIQ(123,SDCSLT_",",3,"I")) ;date converted to HL7
  1. ..;Calculate message control ID
  1. ..S MSGN=MSGN+1
  1. ..S MSGID=HLMID_"-"_MSGN
  1. ..;Build MSG segment
  1. ..I (MSGID'="") D
  1. ...;remember orig message and event type
  1. ...S ORIGMNT="SIU"
  1. ...S ORIGENT="S12"
  1. ...S HL("MNT")="SIU",HL("ETN")=$P(SDAPPT,"^")
  1. ...;build MSH segment
  1. ...K RESULT D MSH^HLFNC2(.HL,MSGID,.RESULT)
  1. ...;reset message & event type to its orig values
  1. ...S HL("MNT")=ORIGMNT
  1. ...S HL("ETN")=ORIGENT
  1. ...;copy MSH segment into HL7 message
  1. ...S @HL7XMIT@(CURLINE)=RESULT
  1. ...N SDFACL S SDFACL=$P($$SITE^VASITE(),"^",3)
  1. ...S $P(@HL7XMIT@(CURLINE),U,4)=SDFACL ;sending facility station #
  1. ...S $P(@HL7XMIT@(CURLINE),U,5)="SD-AAC-PAIT" ;Receiving Application
  1. ...S $P(@HL7XMIT@(CURLINE),U,6)=200 ; Receiving Facility
  1. ...I ($D(RESULT(1))) D
  1. ....S @HL7XMIT@(CURLINE,1)=RESULT(1)
  1. ....S CURLINE=CURLINE+1
  1. ...E S CURLINE=CURLINE+1
  1. ..;get list of segments
  1. ..N SDSCH S SDSCH="SCH"_HLFS_1_"^^^^^"
  1. ..S SD7=SDNAVA
  1. ..;S ^TMP("HLS",$J,CURLINE)
  1. ..S @HL7XMIT@(CURLINE)=SDSCH_SD6_"^"_SD7_"^"_SD8_"^^^"
  1. ..N SDDAT S SDDAT="~~~"_SDDAM_"~~~"_"Date Appt Created|~~~"_SDSDDT_"~~~"_"Desired Date|~~~"_SDADID_"~~~"_"Appt Date"
  1. ..S SDDAT=SDDAT_"|~~~"_SDCHKOUT_"~~~"_"Checkout Date"
  1. ..S SDDAT=SDDAT_"|~~~"_SDCDT_"~~~"_"Cancellation Date"
  1. ..S SDDAT=SDDAT_"|~~~"_SDARDT_"~~~"_"Auto-rebook Date"
  1. ..S SDDAT=SDDAT_"|~~~"_SD8RD_"~~~"_"Resched Date"
  1. ..S SDDAT=SDDAT_"|~~~"_SDCDATE_"~~~"_"Consult Date"
  1. ..;S $P(SDSCH,U,12)=SDDAT,$P(SDSCH,U,26)=SDSTAT
  1. ..S @HL7XMIT@(CURLINE,1)=SDDAT_"^^^^^^^^^^^^^^"_SD25
  1. ..S CURLINE=CURLINE+1
  1. ..S @HL7XMIT@(CURLINE)=$$EN^VAFHLPID(DFN,"1,3,5,7,11,19",1,1)
  1. ..N SDCDFN S SDCDFN=$P(@HL7XMIT@(CURLINE),"^",4),SDCDFN=SDCDFN_"|"_DFN_"~~~USVHA&&L~PI" I $P(SDCDFN,"~")["V" S $P(SDCDFN,"~",2)=""
  1. ..S $P(@HL7XMIT@(CURLINE),"^",4)=SDCDFN
  1. ..N SDZIP S SDZIP=$P(@HL7XMIT@(CURLINE),U,12),SDZIP=$P(SDZIP,"~",5) S $P(@HL7XMIT@(CURLINE),U,12)="~~~~"_SDZIP
  1. ..S CURLINE=CURLINE+1
  1. ..;get Admission Type
  1. ..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)
  1. ..S @HL7XMIT@(CURLINE)="PV1^1^"_SDPATCL_"^^"_SDAT_"^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^"_SDFAC
  1. ..S CURLINE=CURLINE+1
  1. ..S SDNEW=$S(SDNEW=1:"NSF",SDNEW=2:"OPN",SDNEW=3:"SHB")
  1. ..S @HL7XMIT@(CURLINE)="PV2^^^^^^^^^^^^^^^^^^^^^^^^"_SDNEW
  1. ..S CURLINE=CURLINE+1
  1. ..I $D(^TMP("SDDPT",$J,DFN,SDADT,"ROL")) D
  1. ...N SDCNT,SDAIP S SDAIP="AIP^" S SDCNT="" F S SDCNT=$O(^TMP("SDDPT",$J,DFN,SDADT,"ROL",SDCNT)) Q:SDCNT="" D
  1. ....N SDPOVID,SDPROVNM,SDROLS
  1. ....S SDROLS=^TMP("SDDPT",$J,DFN,SDADT,"ROL",SDCNT)
  1. ....S SDPOVID=$P(SDROLS,U,3),SDPROVNM=$P(SDROLS,U,4),SDPROVNM=$TR(SDPROVNM,",","~")
  1. ....S SDPROVNM=$TR(SDPROVNM," ","~")
  1. ....I $L(SDPROVNM,"~")=2 S SDPROVNM=SDPROVNM_"~~"
  1. ....E I $L(SDPROVNM,"~")=3 S SDPROVNM=SDPROVNM_"~"
  1. ....S @HL7XMIT@(CURLINE)=SDAIP_SDCNT_"^^"_SDPOVID_"~"_SDPROVNM_"^"_"Provider"
  1. ....S CURLINE=CURLINE+1
  1. ..S @HL7XMIT@(CURLINE)="AIL^1^^"_SDCL_"~~~~~~~~"_SDCLNM_"^"_SDSTOP_"~"_SDSTOPD_"~DSS Clinic ID^"_SDCSTOP_"~"_SDCSTOPD_"~DSS Credit Stop"
  1. ..S CURLINE=CURLINE+1
  1. ..N SDCNT S SDCNT="" F S SDCNT=$O(^TMP("SDDPT",$J,DFN,SDADT,"ZCL",SDCNT)) Q:SDCNT="" D
  1. ...S @HL7XMIT@(CURLINE)=^TMP("SDDPT",$J,DFN,SDADT,"ZCL",SDCNT,0)
  1. ...S CURLINE=CURLINE+1
  1. ..;create ZEN only if enrollment was retrieved
  1. ..I SDENRO>0 S @HL7XMIT@(CURLINE)="ZEN^1^^^^^^^^"_SDENRO,CURLINE=CURLINE+1
  1. ..S @HL7XMIT@(CURLINE)="ZSP^1^"_SDSC_"^"_SDSCP
  1. ..S CURLINE=CURLINE+1
  1. ..;ZEL
  1. ..N SDZEL D EN1^VAFHLZEL(DFN,"1,37,38",1,.SDZEL) D
  1. ...;need to modify 37 WITH THE CREATION DATE
  1. ...N SDDAMV S SDDAMV=$$HL7TFM^XLFDT(SDDAM)
  1. ...N SDVC S SDVC=$$CVEDT^DGCV(DFN,SDDAMV),SDVC=$P(SDVC,"^",3) D
  1. ....S $P(SDZEL(1),"^",38)=$S(SDVC=1:1,SDVC=0:0,1:"U")
  1. ....I $P(SDZEL(1),"^",39)'?8N S $P(SDZEL(1),"^",39)=""
  1. ...S @HL7XMIT@(CURLINE)=SDZEL(1)
  1. ..S CURLINE=CURLINE+1
  1. ..;ZMH
  1. ..N SAR D ENTER^VAFHLZMH(DFN,"SAR","1,5,10","3,4",HL("FS"),HL("ECH"),"")
  1. ..S $P(SAR(1,0),"^",4)="" ;
  1. ..;service separation date
  1. ..;combat indication and location;gulf war indication
  1. ..S $P(SAR(1,0),"^",5)="~"_$P($P(SAR(1,0),"^",5),"~",2)
  1. ..N SS F SS=2,3 D
  1. ...S $P(SAR(SS,0),"^",5)=""
  1. ..I $E($P(SAR(2,0),"^",4))'="Y" S $P(SAR(2,0),"^",4)="N~"
  1. ..I $E($P(SAR(3,0),"^",4))'="Y" S $P(SAR(3,0),"^",4)="N"
  1. ..N SDD F SDD=1,2,3 S @HL7XMIT@(CURLINE)=SAR(SDD,0) S CURLINE=CURLINE+1
  1. ..;file MSGID into 409.69 separately as batch # and ID #
  1. ..N DIE,DA D
  1. ...S DIE="^SDWL(409.6,"_RUNID_",1,",DA(1)=RUNID
  1. ...S DA=$O(^SDWL(409.6,"AC",DFN,SDADT,RUNID,"")) D
  1. ....I $P(^SDWL(409.6,RUNID,1,DA,0),"^",3)'="" S DA=$O(^SDWL(409.6,"AC",DFN,SDADT,RUNID,DA))
  1. ...S DR="2///"_+MSGID_";3///"_$P(MSGID,"-",2) D ^DIE
  1. D GENERATE^HLMA("SD-PAIT-EVENT","GB",1,.HLRESLT,HLMTIEN,.HLP) K @HL7XMIT
  1. N DA,DIE,DR S DA=RUNID,DIE=409.6,DR="1.1///"_+$G(MSGID) D ^DIE
  1. S SDMCID=+$G(SDMCID)
  1. ;file message control ID # and batch control ID number
  1. N DIC,DA,X,Y D
  1. .S DIC="^SDWL(409.6,"_RUNID_",2,",DA(1)=RUNID,DIC("P")=409.7,DIC(0)="X"
  1. .S SDBCID=+$G(HLRESLT)
  1. .K DO S X=+$G(SDBCID) D FILE^DICN
  1. .S DA=+Y,DIE=DIC,DR=".02///"_+$G(SDDT)_";.03///"_+$G(SDA) D ^DIE
  1. Q