DGRUUTL ;ALB/GRR - RAI/MDS UTILITY ROUTINE ; 10/11/07 8:42am
;;5.3;PIMS;**190,444,1015,1016**;JUN 30, 2012;Build 20
HLNAME(DGNAME) ;Piece apart name into LAST NAME_"^"_FIRST NAME_"^"_MIDDLE NAME_"^"_SUFFIX
;Input DGNAME - Either Last Name, First or First, Middle and Last Name (i.e. SMITH,JOHN R or JOHN R SMITH)
S (DGFN,DGMN,DGLN,DGSUF,P1,P2,P3,P4)=""
I DGNAME'["," S P=$L(DGNAME," ") F Z=1:1:P S @("P"_Z)=$P(DGNAME," ",Z)
I DGNAME["," D
.S P1=$P(DGNAME,","),P2=$P(DGNAME,",",2),DGN=P2_" "_P1
.S P=$L(DGN," ") F Z=1:1:P S @("P"_Z)=$P(DGN," ",Z)
S DGSUF=$$SUF(@("P"_P))
I DGSUF'="" S P=P-1
I P=4 S DGFN=P1,DGMN=P2,DGLN=P3_" "_P4 G NAMQ
I P=3 D G NAMQ
.I $L($P(P2,"."))=1 S DGFN=P1,DGMN=P2,DGLN=P3 Q
.I $L($P(P2,"."))=2 S DGFN=P1,DGLN=P2_" "_P3 Q
.S DGFN=P1,DGMN=P2,DGLN=P3
S DGFN=P1,DGLN=P2
NAMQ Q DGLN_"^"_DGFN_"^"_DGMN_"^"_DGSUF
;
SUF(X) ;COMPARES PASSED DATA TO LIST OF SUFFIX'S AND RETURNS A FOUND SUFFIX OR NULL
I "^JR.^SR.^II.^III.^IV.^V.^VI.^VII.^VIII.^VIIII.^IX.^X."'[X Q ""
Q X
;
CHKWARD(X) ;RETURNS 1 IF RAI/MDS WARD AND 0 IF NOT
;;Input X - Internal Entry Number of Ward in Ward file (#42)
;
Q $S(+X>0:+($$GET1^DIQ(42,X,.035,"I")),1:0)
;
MEDICARE(DFN) ;Will retrieve the patient's Medicare Number and return it or return null
;Input - DFN patient's IEN
Q "" ;ihs/cmi/maw 07/17/2012 PATCH 1016 no IB routines in IHS
N DGSUB ;modified p-444
Q:DFN']"" "" ;p-444
S DGSUB=$$HICN^IBCNSU1(DFN) ;p-444
Q:DGSUB<0 "" ;no medicare number p-444
Q DGSUB
;
MEDICAID(DFN) ;Will retrieve the patient's Medicaid Number and return it or a null
;Input - DFN patient's IEN
;
; Returns the medicaid information from the patient file
; P-762 return Medicaid number or 'N'
N A S A=$$GET1^DIQ(2,DFN,.383)
S:A="" A="N"
Q A
;
GETAMOV(DFN) ;GET LAST ADMISSION MOVEMENT FOR A PATIENT
;
N I,J S (I,J)=""
S I=$O(^DGPM("ATID1",DFN,I)) Q:I="" ""
S J=$O(^DGPM("ATID1",DFN,I,J)) ;ien of admission movement
Q J
;
RELATE(X) ;CONVERT FREE TEXT RELATIONSHIP TO RELATIONSHIP FILE ENTRY NUMBER AND NAME
N DIC,Y
S X=$$UPPER^HLFNC(X)
S X=$S(X="WIFE":"SPOUSE",X="HUSBAND":"SPOUSE",1:X)
S DIC="^DG(408.11,",DIC(0)="X" D ^DIC
S:Y<0 Y="99^OTHER" ;DEFAULT IF NOT FOUND IN FILE
Q Y
;
ENC(DGRSEG,DGRMNMT,DGRFLN,DGRFLNM,DGROLDN,DGRNDATA,DGRSIED,DGCIEN) ;CREATE AND SEND MASTER FILE UPDATE HL7 MESSAGE
;INPUT:
; DGRSEG - File Number
; DGRMNMT - Message Type (ie INSURANCE)
; DGRFLN - Vista File Number (ie 36)
; DGRFLNM - Vista File Name (ie INSURANCE COMPANY)
; DGROLDN - Old Name value
; DGRNDATA - New value (ie BLUE CROSS NH/VT)
; DGRSIED - Server Protocol IEN
; DGRUHLP - Priority of Message (ie I = Immediate)
;
Q:DGRSEG=""!(DGRMNMT="")!(DGRFLN="")!(DGRFLNM="")!(DGRNDATA="")!(DGRSIED="") ;Quit if all parameters not passed
D EN^DGRUGMFU(DGRSEG,DGRMNMT,DGRFLN,DGRFLNM,DGROLDN,DGRNDATA,DGCIEN) ;Call routine which formats the Master File Update
I $D(^TMP($J,"DGRUGMFU",1)) D ;If a Master File Update was created, do the following
.M HLA("HLS")=^TMP($J,"DGRUGMFU") ;Move global array maintaining HL7 message to local array
.D GENERATE^HLMA("DGRU-RAI-MFU-SERVER","LM",1,.DGRUET,"") ;Call API to generate the HL7 message
Q
SENDMFU() ;Function to determine if master file updates should be sent
Q $P($G(^DG(43,1,"HL7")),"^",4)=1
;
DOCID(X) ;Insure provider ID not greater than 6 digits
Q:$E(X,1,3)'="PV1" -1
N DGDOC,DGNIEN,IEN
S DGDOC=$P(X,HL("FS"),8),IEN=$P(DGDOC,$E(HL("ECH")))
I $L(IEN)<7 G EXITDOC
S DGNIEN=$E(IEN,$L(IEN)-5,$L(IEN)),$P(DGDOC,$E(HL("ECH")))=DGNIEN
S $P(X,HL("FS"),8)=DGDOC
EXITDOC Q X
;
ATTDOC(X) ;get attending physician - p-762
N ATTPTR,ATTNAME,VAIP D IN5^VADPT S ATTPTR=$P(VAIP(18),"^",1),ATTNAME=$P(VAIP(18),"^",2) K VAIP
I $L(ATTPTR)>6 S ATTPTR=$E(ATTPTR,$L(ATTPTR)-5,$L(ATTPTR))
I $G(ATTNAME) S ATTNAME=$$HLNAME(ATTNAME)
Q ATTPTR_$E(HL("ECH"))_ATTNAME
DGRUUTL ;ALB/GRR - RAI/MDS UTILITY ROUTINE ; 10/11/07 8:42am
+1 ;;5.3;PIMS;**190,444,1015,1016**;JUN 30, 2012;Build 20
HLNAME(DGNAME) ;Piece apart name into LAST NAME_"^"_FIRST NAME_"^"_MIDDLE NAME_"^"_SUFFIX
+1 ;Input DGNAME - Either Last Name, First or First, Middle and Last Name (i.e. SMITH,JOHN R or JOHN R SMITH)
+2 SET (DGFN,DGMN,DGLN,DGSUF,P1,P2,P3,P4)=""
+3 IF DGNAME'[","
SET P=$LENGTH(DGNAME," ")
FOR Z=1:1:P
SET @("P"_Z)=$PIECE(DGNAME," ",Z)
+4 IF DGNAME[","
Begin DoDot:1
+5 SET P1=$PIECE(DGNAME,",")
SET P2=$PIECE(DGNAME,",",2)
SET DGN=P2_" "_P1
+6 SET P=$LENGTH(DGN," ")
FOR Z=1:1:P
SET @("P"_Z)=$PIECE(DGN," ",Z)
End DoDot:1
+7 SET DGSUF=$$SUF(@("P"_P))
+8 IF DGSUF'=""
SET P=P-1
+9 IF P=4
SET DGFN=P1
SET DGMN=P2
SET DGLN=P3_" "_P4
GOTO NAMQ
+10 IF P=3
Begin DoDot:1
+11 IF $LENGTH($PIECE(P2,"."))=1
SET DGFN=P1
SET DGMN=P2
SET DGLN=P3
QUIT
+12 IF $LENGTH($PIECE(P2,"."))=2
SET DGFN=P1
SET DGLN=P2_" "_P3
QUIT
+13 SET DGFN=P1
SET DGMN=P2
SET DGLN=P3
End DoDot:1
GOTO NAMQ
+14 SET DGFN=P1
SET DGLN=P2
NAMQ QUIT DGLN_"^"_DGFN_"^"_DGMN_"^"_DGSUF
+1 ;
SUF(X) ;COMPARES PASSED DATA TO LIST OF SUFFIX'S AND RETURNS A FOUND SUFFIX OR NULL
+1 IF "^JR.^SR.^II.^III.^IV.^V.^VI.^VII.^VIII.^VIIII.^IX.^X."'[X
QUIT ""
+2 QUIT X
+3 ;
CHKWARD(X) ;RETURNS 1 IF RAI/MDS WARD AND 0 IF NOT
+1 ;;Input X - Internal Entry Number of Ward in Ward file (#42)
+2 ;
+3 QUIT $SELECT(+X>0:+($$GET1^DIQ(42,X,.035,"I")),1:0)
+4 ;
MEDICARE(DFN) ;Will retrieve the patient's Medicare Number and return it or return null
+1 ;Input - DFN patient's IEN
+2 ;ihs/cmi/maw 07/17/2012 PATCH 1016 no IB routines in IHS
QUIT ""
+3 ;modified p-444
NEW DGSUB
+4 ;p-444
IF DFN']""
QUIT ""
+5 ;p-444
SET DGSUB=$$HICN^IBCNSU1(DFN)
+6 ;no medicare number p-444
IF DGSUB<0
QUIT ""
+7 QUIT DGSUB
+8 ;
MEDICAID(DFN) ;Will retrieve the patient's Medicaid Number and return it or a null
+1 ;Input - DFN patient's IEN
+2 ;
+3 ; Returns the medicaid information from the patient file
+4 ; P-762 return Medicaid number or 'N'
+5 NEW A
SET A=$$GET1^DIQ(2,DFN,.383)
+6 IF A=""
SET A="N"
+7 QUIT A
+8 ;
GETAMOV(DFN) ;GET LAST ADMISSION MOVEMENT FOR A PATIENT
+1 ;
+2 NEW I,J
SET (I,J)=""
+3 SET I=$ORDER(^DGPM("ATID1",DFN,I))
IF I=""
QUIT ""
+4 ;ien of admission movement
SET J=$ORDER(^DGPM("ATID1",DFN,I,J))
+5 QUIT J
+6 ;
RELATE(X) ;CONVERT FREE TEXT RELATIONSHIP TO RELATIONSHIP FILE ENTRY NUMBER AND NAME
+1 NEW DIC,Y
+2 SET X=$$UPPER^HLFNC(X)
+3 SET X=$SELECT(X="WIFE":"SPOUSE",X="HUSBAND":"SPOUSE",1:X)
+4 SET DIC="^DG(408.11,"
SET DIC(0)="X"
DO ^DIC
+5 ;DEFAULT IF NOT FOUND IN FILE
IF Y<0
SET Y="99^OTHER"
+6 QUIT Y
+7 ;
ENC(DGRSEG,DGRMNMT,DGRFLN,DGRFLNM,DGROLDN,DGRNDATA,DGRSIED,DGCIEN) ;CREATE AND SEND MASTER FILE UPDATE HL7 MESSAGE
+1 ;INPUT:
+2 ; DGRSEG - File Number
+3 ; DGRMNMT - Message Type (ie INSURANCE)
+4 ; DGRFLN - Vista File Number (ie 36)
+5 ; DGRFLNM - Vista File Name (ie INSURANCE COMPANY)
+6 ; DGROLDN - Old Name value
+7 ; DGRNDATA - New value (ie BLUE CROSS NH/VT)
+8 ; DGRSIED - Server Protocol IEN
+9 ; DGRUHLP - Priority of Message (ie I = Immediate)
+10 ;
+11 ;Quit if all parameters not passed
IF DGRSEG=""!(DGRMNMT="")!(DGRFLN="")!(DGRFLNM="")!(DGRNDATA="")!(DGRSIED="")
QUIT
+12 ;Call routine which formats the Master File Update
DO EN^DGRUGMFU(DGRSEG,DGRMNMT,DGRFLN,DGRFLNM,DGROLDN,DGRNDATA,DGCIEN)
+13 ;If a Master File Update was created, do the following
IF $DATA(^TMP($JOB,"DGRUGMFU",1))
Begin DoDot:1
+14 ;Move global array maintaining HL7 message to local array
MERGE HLA("HLS")=^TMP($JOB,"DGRUGMFU")
+15 ;Call API to generate the HL7 message
DO GENERATE^HLMA("DGRU-RAI-MFU-SERVER","LM",1,.DGRUET,"")
End DoDot:1
+16 QUIT
SENDMFU() ;Function to determine if master file updates should be sent
+1 QUIT $PIECE($GET(^DG(43,1,"HL7")),"^",4)=1
+2 ;
DOCID(X) ;Insure provider ID not greater than 6 digits
+1 IF $EXTRACT(X,1,3)'="PV1"
QUIT -1
+2 NEW DGDOC,DGNIEN,IEN
+3 SET DGDOC=$PIECE(X,HL("FS"),8)
SET IEN=$PIECE(DGDOC,$EXTRACT(HL("ECH")))
+4 IF $LENGTH(IEN)<7
GOTO EXITDOC
+5 SET DGNIEN=$EXTRACT(IEN,$LENGTH(IEN)-5,$LENGTH(IEN))
SET $PIECE(DGDOC,$EXTRACT(HL("ECH")))=DGNIEN
+6 SET $PIECE(X,HL("FS"),8)=DGDOC
EXITDOC QUIT X
+1 ;
ATTDOC(X) ;get attending physician - p-762
+1 NEW ATTPTR,ATTNAME,VAIP
DO IN5^VADPT
SET ATTPTR=$PIECE(VAIP(18),"^",1)
SET ATTNAME=$PIECE(VAIP(18),"^",2)
KILL VAIP
+2 IF $LENGTH(ATTPTR)>6
SET ATTPTR=$EXTRACT(ATTPTR,$LENGTH(ATTPTR)-5,$LENGTH(ATTPTR))
+3 IF $GET(ATTNAME)
SET ATTNAME=$$HLNAME(ATTNAME)
+4 QUIT ATTPTR_$EXTRACT(HL("ECH"))_ATTNAME
