Changeset 623 for WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGRUUTL.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/DGRUUTL.m
r613 r623 1 DGRUUTL ;ALB/GRR - RAI/MDS UTILITY ROUTINE ; 10/11/07 8:42am 2 ;;5.3;Registration;**190,444,762**;Aug 13, 1993;Build 3 3 HLNAME(DGNAME) ;Piece apart name into LAST NAME_"^"_FIRST NAME_"^"_MIDDLE NAME_"^"_SUFFIX 4 ;Input DGNAME - Either Last Name, First or First, Middle and Last Name (i.e. SMITH,JOHN R or JOHN R SMITH) 5 S (DGFN,DGMN,DGLN,DGSUF,P1,P2,P3,P4)="" 6 I DGNAME'["," S P=$L(DGNAME," ") F Z=1:1:P S @("P"_Z)=$P(DGNAME," ",Z) 7 I DGNAME["," D 8 .S P1=$P(DGNAME,","),P2=$P(DGNAME,",",2),DGN=P2_" "_P1 9 .S P=$L(DGN," ") F Z=1:1:P S @("P"_Z)=$P(DGN," ",Z) 10 S DGSUF=$$SUF(@("P"_P)) 11 I DGSUF'="" S P=P-1 12 I P=4 S DGFN=P1,DGMN=P2,DGLN=P3_" "_P4 G NAMQ 13 I P=3 D G NAMQ 14 .I $L($P(P2,"."))=1 S DGFN=P1,DGMN=P2,DGLN=P3 Q 15 .I $L($P(P2,"."))=2 S DGFN=P1,DGLN=P2_" "_P3 Q 16 .S DGFN=P1,DGMN=P2,DGLN=P3 17 S DGFN=P1,DGLN=P2 18 NAMQ Q DGLN_"^"_DGFN_"^"_DGMN_"^"_DGSUF 19 ; 20 SUF(X) ;COMPARES PASSED DATA TO LIST OF SUFFIX'S AND RETURNS A FOUND SUFFIX OR NULL 21 I "^JR.^SR.^II.^III.^IV.^V.^VI.^VII.^VIII.^VIIII.^IX.^X."'[X Q "" 22 Q X 23 ; 24 CHKWARD(X) ;RETURNS 1 IF RAI/MDS WARD AND 0 IF NOT 25 ;;Input X - Internal Entry Number of Ward in Ward file (#42) 26 ; 27 Q $S(+X>0:+($$GET1^DIQ(42,X,.035,"I")),1:0) 28 ; 29 MEDICARE(DFN) ;Will retrieve the patient's Medicare Number and return it or return null 30 ;Input - DFN patient's IEN 31 N DGSUB ;modified p-444 32 Q:DFN']"" "" ;p-444 33 S DGSUB=$$HICN^IBCNSU1(DFN) ;p-444 34 Q:DGSUB<0 "" ;no medicare number p-444 35 Q DGSUB 36 ; 37 MEDICAID(DFN) ;Will retrieve the patient's Medicaid Number and return it or a null 38 ;Input - DFN patient's IEN 39 ; 40 ; Returns the medicaid information from the patient file 41 ; P-762 return Medicaid number or 'N' 42 N A S A=$$GET1^DIQ(2,DFN,.383) 43 S:A="" A="N" 44 Q A 45 ; 46 GETAMOV(DFN) ;GET LAST ADMISSION MOVEMENT FOR A PATIENT 47 ; 48 N I,J S (I,J)="" 49 S I=$O(^DGPM("ATID1",DFN,I)) Q:I="" "" 50 S J=$O(^DGPM("ATID1",DFN,I,J)) ;ien of admission movement 51 Q J 52 ; 53 RELATE(X) ;CONVERT FREE TEXT RELATIONSHIP TO RELATIONSHIP FILE ENTRY NUMBER AND NAME 54 N DIC,Y 55 S X=$$UPPER^HLFNC(X) 56 S X=$S(X="WIFE":"SPOUSE",X="HUSBAND":"SPOUSE",1:X) 57 S DIC="^DG(408.11,",DIC(0)="X" D ^DIC 58 S:Y<0 Y="99^OTHER" ;DEFAULT IF NOT FOUND IN FILE 59 Q Y 60 ; 61 ENC(DGRSEG,DGRMNMT,DGRFLN,DGRFLNM,DGROLDN,DGRNDATA,DGRSIED,DGCIEN) ;CREATE AND SEND MASTER FILE UPDATE HL7 MESSAGE 62 ;INPUT: 63 ; DGRSEG - File Number 64 ; DGRMNMT - Message Type (ie INSURANCE) 65 ; DGRFLN - Vista File Number (ie 36) 66 ; DGRFLNM - Vista File Name (ie INSURANCE COMPANY) 67 ; DGROLDN - Old Name value 68 ; DGRNDATA - New value (ie BLUE CROSS NH/VT) 69 ; DGRSIED - Server Protocol IEN 70 ; DGRUHLP - Priority of Message (ie I = Immediate) 71 ; 72 Q:DGRSEG=""!(DGRMNMT="")!(DGRFLN="")!(DGRFLNM="")!(DGRNDATA="")!(DGRSIED="") ;Quit if all parameters not passed 73 D EN^DGRUGMFU(DGRSEG,DGRMNMT,DGRFLN,DGRFLNM,DGROLDN,DGRNDATA,DGCIEN) ;Call routine which formats the Master File Update 74 I $D(^TMP($J,"DGRUGMFU",1)) D ;If a Master File Update was created, do the following 75 .M HLA("HLS")=^TMP($J,"DGRUGMFU") ;Move global array maintaining HL7 message to local array 76 .D GENERATE^HLMA("DGRU-RAI-MFU-SERVER","LM",1,.DGRUET,"") ;Call API to generate the HL7 message 77 Q 78 SENDMFU() ;Function to determine if master file updates should be sent 79 Q $P($G(^DG(43,1,"HL7")),"^",4)=1 80 ; 81 DOCID(X) ;Insure provider ID not greater than 6 digits 82 Q:$E(X,1,3)'="PV1" -1 83 N DGDOC,DGNIEN,IEN 84 S DGDOC=$P(X,HL("FS"),8),IEN=$P(DGDOC,$E(HL("ECH"))) 85 I $L(IEN)<7 G EXITDOC 86 S DGNIEN=$E(IEN,$L(IEN)-5,$L(IEN)),$P(DGDOC,$E(HL("ECH")))=DGNIEN 87 S $P(X,HL("FS"),8)=DGDOC 88 EXITDOC Q X 89 ; 90 ATTDOC(X) ;get attending physician - p-762 91 N ATTPTR,ATTNAME,VAIP D IN5^VADPT S ATTPTR=$P(VAIP(18),"^",1),ATTNAME=$P(VAIP(18),"^",2) K VAIP 92 I $L(ATTPTR)>6 S ATTPTR=$E(ATTPTR,$L(ATTPTR)-5,$L(ATTPTR)) 93 I $G(ATTNAME) S ATTNAME=$$HLNAME(ATTNAME) 94 Q ATTPTR_$E(HL("ECH"))_ATTNAME 1 DGRUUTL ;ALB/GRR - RAI/MDS UTILITY ROUTINE 2 ;;5.3;Registration;**190,444**;Aug 13, 1993 3 HLNAME(DGNAME) ;Piece apart name into LAST NAME_"^"_FIRST NAME_"^"_MIDDLE NAME_"^"_SUFFIX 4 ;Input DGNAME - Either Last Name, First or First, Middle and Last Name (i.e. SMITH,JOHN R or JOHN R SMITH) 5 S (DGFN,DGMN,DGLN,DGSUF,P1,P2,P3,P4)="" 6 I DGNAME'["," S P=$L(DGNAME," ") F Z=1:1:P S @("P"_Z)=$P(DGNAME," ",Z) 7 I DGNAME["," D 8 .S P1=$P(DGNAME,","),P2=$P(DGNAME,",",2),DGN=P2_" "_P1 9 .S P=$L(DGN," ") F Z=1:1:P S @("P"_Z)=$P(DGN," ",Z) 10 S DGSUF=$$SUF(@("P"_P)) 11 I DGSUF'="" S P=P-1 12 I P=4 S DGFN=P1,DGMN=P2,DGLN=P3_" "_P4 G NAMQ 13 I P=3 D G NAMQ 14 .I $L($P(P2,"."))=1 S DGFN=P1,DGMN=P2,DGLN=P3 Q 15 .I $L($P(P2,"."))=2 S DGFN=P1,DGLN=P2_" "_P3 Q 16 .S DGFN=P1,DGMN=P2,DGLN=P3 17 S DGFN=P1,DGLN=P2 18 NAMQ Q DGLN_"^"_DGFN_"^"_DGMN_"^"_DGSUF 19 ; 20 SUF(X) ;COMPARES PASSED DATA TO LIST OF SUFFIX'S AND RETURNS A FOUND SUFFIX OR NULL 21 I "^JR.^SR.^II.^III.^IV.^V.^VI.^VII.^VIII.^VIIII.^IX.^X."'[X Q "" 22 Q X 23 ; 24 CHKWARD(X) ;RETURNS 1 IF RAI/MDS WARD AND 0 IF NOT 25 ;;Input X - Internal Entry Number of Ward in Ward file (#42) 26 ; 27 Q $S(+X>0:+($$GET1^DIQ(42,X,.035,"I")),1:0) 28 ; 29 MEDICARE(DFN) ;Will retrieve the patient's Medicare Number and return it or return null 30 ;Input - DFN patient's IEN 31 N DGSUB ;modified p-444 32 Q:DFN']"" "" ;p-444 33 S DGSUB=$$HICN^IBCNSU1(DFN) ;p-444 34 Q:DGSUB<0 "" ;no medicare number p-444 35 Q DGSUB 36 ; 37 MEDICAID(DFN) ;Will retrieve the patient's Medicaid Number and return it or a null 38 ;Input - DFN patient's IEN 39 ; 40 ; Returns the medicaid information from the patient file 41 Q $$GET1^DIQ(2,DFN,.383) 42 ; 43 GETAMOV(DFN) ;GET LAST ADMISSION MOVEMENT FOR A PATIENT 44 ; 45 N I,J S (I,J)="" 46 S I=$O(^DGPM("ATID1",DFN,I)) Q:I="" "" 47 S J=$O(^DGPM("ATID1",DFN,I,J)) ;ien of admission movement 48 Q J 49 ; 50 RELATE(X) ;CONVERT FREE TEXT RELATIONSHIP TO RELATIONSHIP FILE ENTRY NUMBER AND NAME 51 N DIC,Y 52 S X=$$UPPER^HLFNC(X) 53 S X=$S(X="WIFE":"SPOUSE",X="HUSBAND":"SPOUSE",1:X) 54 S DIC="^DG(408.11,",DIC(0)="X" D ^DIC 55 S:Y<0 Y="99^OTHER" ;DEFAULT IF NOT FOUND IN FILE 56 Q Y 57 ; 58 ENC(DGRSEG,DGRMNMT,DGRFLN,DGRFLNM,DGROLDN,DGRNDATA,DGRSIED,DGCIEN) ;CREATE AND SEND MASTER FILE UPDATE HL7 MESSAGE 59 ;INPUT: 60 ; DGRSEG - File Number 61 ; DGRMNMT - Message Type (ie INSURANCE) 62 ; DGRFLN - Vista File Number (ie 36) 63 ; DGRFLNM - Vista File Name (ie INSURANCE COMPANY) 64 ; DGROLDN - Old Name value 65 ; DGRNDATA - New value (ie BLUE CROSS NH/VT) 66 ; DGRSIED - Server Protocol IEN 67 ; DGRUHLP - Priority of Message (ie I = Immediate) 68 ; 69 Q:DGRSEG=""!(DGRMNMT="")!(DGRFLN="")!(DGRFLNM="")!(DGRNDATA="")!(DGRSIED="") ;Quit if all parameters not passed 70 D EN^DGRUGMFU(DGRSEG,DGRMNMT,DGRFLN,DGRFLNM,DGROLDN,DGRNDATA,DGCIEN) ;Call routine which formats the Master File Update 71 I $D(^TMP($J,"DGRUGMFU",1)) D ;If a Master File Update was created, do the following 72 .M HLA("HLS")=^TMP($J,"DGRUGMFU") ;Move global array maintaining HL7 message to local array 73 .D GENERATE^HLMA("DGRU-RAI-MFU-SERVER","LM",1,.DGRUET,"") ;Call API to generate the HL7 message 74 Q 75 SENDMFU() ;Function to determine if master file updates should be sent 76 Q $P($G(^DG(43,1,"HL7")),"^",4)=1 77 ; 78 DOCID(X) ;Insure provider ID not greater than 6 digits 79 Q:$E(X,1,3)'="PV1" -1 80 N DGDOC,DGNIEN,IEN 81 S DGDOC=$P(X,HL("FS"),8),IEN=$P(DGDOC,$E(HL("ECH"))) 82 I $L(IEN)<7 G EXITDOC 83 S DGNIEN=$E(IEN,$L(IEN)-5,$L(IEN)),$P(DGDOC,$E(HL("ECH")))=DGNIEN 84 S $P(X,HL("FS"),8)=DGDOC 85 EXITDOC Q X 86 ;
Note:
See TracChangeset
for help on using the changeset viewer.
