source: WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGRUUTL.m@ 1747

Last change on this file since 1747 was 623, checked in by George Lilly, 15 years ago

revised back to 6/30/08 version

File size: 3.4 KB
Line 
1DGRUUTL ;ALB/GRR - RAI/MDS UTILITY ROUTINE
2 ;;5.3;Registration;**190,444**;Aug 13, 1993
3HLNAME(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
18NAMQ Q DGLN_"^"_DGFN_"^"_DGMN_"^"_DGSUF
19 ;
20SUF(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 ;
24CHKWARD(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 ;
29MEDICARE(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 ;
37MEDICAID(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 ;
43GETAMOV(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 ;
50RELATE(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 ;
58ENC(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
75SENDMFU() ;Function to determine if master file updates should be sent
76 Q $P($G(^DG(43,1,"HL7")),"^",4)=1
77 ;
78DOCID(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
85EXITDOC Q X
86 ;
Note: See TracBrowser for help on using the repository browser.