Changeset 623 for WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGRUGBJ.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGRUGBJ.m
r613 r623 1 DGRUGBJ ; ALB/SCK - RAI/MDS COTS ADT Background job ; 11/7/07 3:49pm 2 ;;5.3;Registration;**190,312,357,762**;Aug 13, 1993;Build 3 3 ; 4 EN ; Main Entry point for patient demographic update to COTS system 5 ; 6 L +^XTMP("ADT/HL7 MDS COTS UPDATE"):3 E Q 7 ; 8 ; Check for HL7 send parameter 9 Q:'$P($$SEND^VAFHUTL(),"^",2) 10 ; 11 ; Look for patient demographic changes monitored by the COTS system 12 N PVTPTR,DGNODE,DFN,DGDATE,DGARRAY,DGUSR,DGRSLT 13 ; 14 S DGARRAY="^TMP(""DGRAI"",""EVNTINFO"","_$J_")" 15 K @DGARRAY 16 ; 17 ; Begin looking for entries needing transmission with a type of "COTS UPDATE", Code 6. 18 S PVTPTR=0 19 F S PVTPTR=+$O(^VAT(391.71,"AXMIT",6,PVTPTR)) Q:('PVTPTR) D 20 . ; If no entry for xref (out of sync) delete the xref and quit 21 . I ('$D(^VAT(391.71,PVTPTR))) K ^VAT(391.71,"AXMIT",6,PVTPTR) Q 22 . ; Get event date and pointer to patient for entry 23 . S DGNODE=$G(^VAT(391.71,PVTPTR,0)) 24 . S DFN=+$P(DGNODE,"^",3) 25 . S EVNTDT=+DGNODE 26 . ; Check for patient, if not valid, then mark as transmitted and quit 27 . I ('$D(^DPT(DFN,0))) D XMITFLAG^VAFCDD01(PVTPTR,"",1) Q 28 . N VAIN D INP^VADPT ; p-762 29 . I '$$CHKWARD^DGRUUTL(+VAIN(4)) D XMITFLAG^VAFCDD01(PVTPTR,"",1) K VAIN Q ; P-762 30 . K @DGARRAY 31 . S @DGARRAY@("PIVOT")=PVTPTR 32 . S @DGARRAY@("REASON",1)="" 33 . I (+$G(^DPT(DFN,.35))) S @DGARRAY@("REASON",1)=99 34 . ; 35 . S @DGARRAY@("USER")=$$GET1^DIQ(200,+$P(DGNODE,"^",9),.01) 36 . ; 37 . S @DGARRAY@("EVENT-NUM")=$P(DGNODE,"^",2) 38 . S @DGARRAY@("VAR-PTR")=$P(DGNODE,"^",5) 39 . ; 40 . S DGRSLT=$$BLDA08(DFN,EVNTDT,DGARRAY) 41 . I (DGRSLT<0) D ERRBUL(DGARRAY,DGRSLT) ;deleted Q p-357 42 . ; 43 . ; Mark entry in pivot file as transmitted 44 . D XMITFLAG^VAFCDD01(PVTPTR,"",1) 45 ; 46 L -^XTMP("ADT/HL7 MDS COTS UPDATE") 47 Q 48 ; 49 BLDA08(DFN,EVNTDT,EVNTINFO,DGDC,DGOSSN) ; 50 ; 51 N RESULT,DGTMP,GLOREF 52 ; 53 S DFN=+$G(DFN) 54 I ('$D(^DPT(DFN,0))) S RESULT="-1^Could not find entry in PATIENT file" G BLDQ 55 ; 56 S DGDC=$G(DGDC) 57 S DGOSSN=$G(DGOSSN) 58 S EVNTDT=$G(EVNTDT) 59 S:('EVNTDT) EVNTDT=$$NOW^XLFDT 60 ; 61 S GLOREF="^TMP(""HLS"","_$J_")" 62 K @GLOREF 63 ; 64 S @EVNTINFO@("DFN")=DFN 65 S @EVNTINFO@("EVENT")="A08" 66 S @EVNTINFO@("DATE")=EVNTDT 67 ; 68 N HLEID,HL,HLFS,HLECH,HLQ,NDX 69 ; 70 K HL 71 D INIT^HLFNC2("DGRU-PATIENT-A08-SERVER",.HL) 72 ; 73 I ($O(HL(""))']"") S RESULT="-1^Server Protocol not found" G BLDQ 74 ; 75 ; Build segment array 76 D EN^DGRUGA08(DFN,"","DGTMP",DGDC,DGOSSN) 77 I '$O(DGTMP(0)) S RESULT="-1^Unable to build segment list to transmit" G BLDQ 78 ;Check segment list for errors 79 S NDX=0 80 F S NDX=$O(DGTMP(NDX)) Q:'NDX D G:(+$G(RESULT)<0) BLDQ 81 . I +DGTMP(NDX)<0 S RESULT="-1^An error occurred in one of the segments" 82 ; 83 M @GLOREF=DGTMP 84 S RESULT=$$SENDMSG(GLOREF) 85 I +$P(RESULT,"^",2)>0 S RESULT="-1^"_$P(RESULT,"^",2,3) 86 BLDQ Q $G(RESULT) 87 ; 88 SENDMSG(GLOREF) ; Transmit the HL7 message 89 N HLA,HLRST 90 M HLA("HLS")=@GLOREF 91 I $D(HLA("HLS")) D 92 . D GENERATE^HLMA("DGRU-PATIENT-A08-SERVER","LM",1,.HLRST,"") 93 K HLA,HERR 94 Q (HLRST) 95 ; 96 ERRBUL(EVNTINFO,RESULT) ; Generate bulletin if an error occurred while building the HL7 message. 97 ; 98 N XMY,XMDUZ,XMDT,XMZ,XMB,XMCHAN,XMSUB 99 ; 100 S XMCHAN=1 101 S XMSUB="RAI/MDS HL7 BUILD ERROR" 102 S (XMDUZ,XMDUZ)="RAI/MDS APPLICATION" 103 ; 104 S XMB="DGRU RAI ERROR" 105 S XMB(1)=$$GET1^DIQ(2,@EVNTINFO@("DFN"),.01) 106 S XMB(2)=@EVNTINFO@("EVENT") 107 S XMB(3)=">>> "_$P(RESULT,"^",2) 108 S XMB(4)=@EVNTINFO@("USER") 109 S XMB(5)=$$FMTE^XLFDT(@EVNTINFO@("DATE")) 110 S XMDT=DT 111 D ^XMB 112 Q 1 DGRUGBJ ; ALB/SCK - RAI/MDS COTS ADT Background job ; 8-10-99 2 ;;5.3;Registration;**190,312,357**;Aug 13, 1993 3 ; 4 EN ; Main Entry point for patient demographic update to COTS system 5 ; 6 L +^XTMP("ADT/HL7 MDS COTS UPDATE"):3 E Q 7 ; 8 ; Check for HL7 send parameter 9 Q:'$P($$SEND^VAFHUTL(),"^",2) 10 ; 11 ; Look for patient demographic changes monitored by the COTS system 12 N PVTPTR,DGNODE,DFN,DGDATE,DGARRAY,DGUSR,DGRSLT 13 ; 14 S DGARRAY="^TMP(""DGRAI"",""EVNTINFO"","_$J_")" 15 K @DGARRAY 16 ; 17 ; Begin looking for entries needing transmission with a type of "COTS UPDATE", Code 6. 18 S PVTPTR=0 19 F S PVTPTR=+$O(^VAT(391.71,"AXMIT",6,PVTPTR)) Q:('PVTPTR) D 20 . ; If no entry for xref (out of sync) delete the xref and quit 21 . I ('$D(^VAT(391.71,PVTPTR))) K ^VAT(391.71,"AXMIT",6,PVTPTR) Q 22 . ; Get event date and pointer to patient for entry 23 . S DGNODE=$G(^VAT(391.71,PVTPTR,0)) 24 . S DFN=+$P(DGNODE,"^",3) 25 . S EVNTDT=+DGNODE 26 . ; Check for patient, if not valid, then mark as transmitted and quit 27 . I ('$D(^DPT(DFN,0))) D XMITFLAG^VAFCDD01(PVTPTR,"",1) Q 28 . ; 29 . K @DGARRAY 30 . S @DGARRAY@("PIVOT")=PVTPTR 31 . S @DGARRAY@("REASON",1)="" 32 . I (+$G(^DPT(DFN,.35))) S @DGARRAY@("REASON",1)=99 33 . ; 34 . S @DGARRAY@("USER")=$$GET1^DIQ(200,+$P(DGNODE,"^",9),.01) 35 . ; 36 . S @DGARRAY@("EVENT-NUM")=$P(DGNODE,"^",2) 37 . S @DGARRAY@("VAR-PTR")=$P(DGNODE,"^",5) 38 . ; 39 . S DGRSLT=$$BLDA08(DFN,EVNTDT,DGARRAY) 40 . I (DGRSLT<0) D ERRBUL(DGARRAY,DGRSLT) ;deleted Q p-357 41 . ; 42 . ; Mark entry in pivot file as transmitted 43 . D XMITFLAG^VAFCDD01(PVTPTR,"",1) 44 ; 45 L -^XTMP("ADT/HL7 MDS COTS UPDATE") 46 Q 47 ; 48 BLDA08(DFN,EVNTDT,EVNTINFO,DGDC,DGOSSN) ; 49 ; 50 N RESULT,DGTMP,GLOREF 51 ; 52 S DFN=+$G(DFN) 53 I ('$D(^DPT(DFN,0))) S RESULT="-1^Could not find entry in PATIENT file" G BLDQ 54 ; 55 S DGDC=$G(DGDC) 56 S DGOSSN=$G(DGOSSN) 57 S EVNTDT=$G(EVNTDT) 58 S:('EVNTDT) EVNTDT=$$NOW^XLFDT 59 ; 60 S GLOREF="^TMP(""HLS"","_$J_")" 61 K @GLOREF 62 ; 63 S @EVNTINFO@("DFN")=DFN 64 S @EVNTINFO@("EVENT")="A08" 65 S @EVNTINFO@("DATE")=EVNTDT 66 ; 67 N HLEID,HL,HLFS,HLECH,HLQ,NDX 68 ; 69 K HL 70 D INIT^HLFNC2("DGRU-PATIENT-A08-SERVER",.HL) 71 ; 72 I ($O(HL(""))']"") S RESULT="-1^Server Protocol not found" G BLDQ 73 ; 74 ; Build segment array 75 D EN^DGRUGA08(DFN,"","DGTMP",DGDC,DGOSSN) 76 I '$O(DGTMP(0)) S RESULT="-1^Unable to build segment list to transmit" G BLDQ 77 ;Check segment list for errors 78 S NDX=0 79 F S NDX=$O(DGTMP(NDX)) Q:'NDX D G:(+$G(RESULT)<0) BLDQ 80 . I +DGTMP(NDX)<0 S RESULT="-1^An error occurred in one of the segments" 81 ; 82 M @GLOREF=DGTMP 83 S RESULT=$$SENDMSG(GLOREF) 84 I +$P(RESULT,"^",2)>0 S RESULT="-1^"_$P(RESULT,"^",2,3) 85 BLDQ Q $G(RESULT) 86 ; 87 SENDMSG(GLOREF) ; Transmit the HL7 message 88 N HLA,HLRST 89 M HLA("HLS")=@GLOREF 90 I $D(HLA("HLS")) D 91 . D GENERATE^HLMA("DGRU-PATIENT-A08-SERVER","LM",1,.HLRST,"") 92 K HLA,HERR 93 Q (HLRST) 94 ; 95 ERRBUL(EVNTINFO,RESULT) ; Generate bulliten if an error occurred while building the HL7 message. 96 ; 97 N XMY,XMDUZ,XMDT,XMZ,XMB,XMCHAN,XMSUB 98 ; 99 S XMCHAN=1 100 S XMSUB="RAI/MDS HL7 BUILD ERROR" 101 S (XMDUZ,XMDUZ)="RAI/MDS APPLICATION" 102 ; 103 S XMB="DGRU RAI ERROR" 104 S XMB(1)=$$GET1^DIQ(2,@EVNTINFO@("DFN"),.01) 105 S XMB(2)=@EVNTINFO@("EVENT") 106 S XMB(3)=">>> "_$P(RESULT,"^",2) 107 S XMB(4)=@EVNTINFO@("USER") 108 S XMB(5)=$$FMTE^XLFDT(@EVNTINFO@("DATE")) 109 S XMDT=DT 110 D ^XMB 111 Q
Note:
See TracChangeset
for help on using the changeset viewer.
