- DGRUUTL ;ALB/GRR - RAI/MDS UTILITY ROUTINE ; 10/11/07 8:42am
- ;;5.3;Registration;**190,444,762**;Aug 13, 1993;Build 3
- 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
- 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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGRUUTL 3903 printed Jan 18, 2025@03:59:23 Page 2
- DGRUUTL ;ALB/GRR - RAI/MDS UTILITY ROUTINE ; 10/11/07 8:42am
- +1 ;;5.3;Registration;**190,444,762**;Aug 13, 1993;Build 3
- 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 ;modified p-444
- NEW DGSUB
- +3 ;p-444
- if DFN']""
- QUIT ""
- +4 ;p-444
- SET DGSUB=$$HICN^IBCNSU1(DFN)
- +5 ;no medicare number p-444
- if DGSUB<0
- QUIT ""
- +6 QUIT DGSUB
- +7 ;
- 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