109 lines
4.1 KiB
Mathematica
109 lines
4.1 KiB
Mathematica
|
RMIMHL ;WPB/JLTP ; FIM HL7 UTILITY ; 20-SEPT-2002
|
||
|
|
;;1.0;FUNCTIONAL INDEPENDENCE;;Apr 15, 2003
|
||
|
|
SND(X) ; Generate HL7 Message for Austin
|
||
|
|
N ADMDT,CS,DA,DCDT,DIE,DME,DR,FS,HL,HLA,HLI,I,IDX,IFN,RC,RES,RM,T,TYPES
|
||
|
|
S IFN=+$G(X)
|
||
|
|
D INIT^HLFNC2("RMIM DRIVER",.HL) I $G(HL) Q -1
|
||
|
|
S FS=HL("FS"),CS=$E(HL("ECH")),RC=$E(HL("ECH"),2)
|
||
|
|
F I=0:1:8 S RM(I)=$G(^RMIM(783,IFN,I))
|
||
|
|
S HLA("HLS",1)=$$PID,HLA("HLS",2)=$$PV1,HLA("HLS",3)=$$NTE
|
||
|
|
S HLA("HLS",4)=$$OBR,HLA("HLS",5)=$$OBXDG,IDX=5
|
||
|
|
S TYPES="ADMISSION^DISCHARGE^INTERIM^FOLLOW-UP^GOALS" F T=1:1:5 D
|
||
|
|
.Q:RM(T+3)?."^" S IDX=IDX+1,HLA("HLS",IDX)=$$OBXS(T)
|
||
|
|
;S (I,HLI)=0 F S I=$O(^RMIM(783,IFN,100,I)) Q:'I S X=^(I,0) D
|
||
|
|
;.S HLI=HLI+1,IDX=IDX+1,HLA("HLS",IDX)=$$OBXN(X)
|
||
|
|
S X=$G(^RMIM(783,IFN,0)),ADMDT=$P(X,U,10),DCDT=$P(X,U,11),DFN=$P(X,U,3)
|
||
|
|
S X=DFN_U_ADMDT_U_DCDT
|
||
|
|
I DCDT]"",ADMDT]"" D DME^RMIMRP(.DME,X) D
|
||
|
|
.S I=0 F S I=$O(DME(I)) Q:'I D
|
||
|
|
..S DME="OBX"_FS_I_FS_"TX"_FS_"DME ITEMS"_FS_FS_DME(I)
|
||
|
|
..S $P(DME,FS,12)="F"
|
||
|
|
..S IDX=IDX+1,HLA("HLS",IDX)=DME
|
||
|
|
D GENERATE^HLMA("RMIM DRIVER","LM",1,.RES)
|
||
|
|
S DIE="^RMIM(783,",DA=IFN,DR=".13///T" D ^DIE
|
||
|
|
Q RES
|
||
|
|
PID() ; Build and Return the PID Segment
|
||
|
|
N ADDR,CASE,CITY,DFN,DOB,MARRIED,PHONE,PID,PNM,RACE,SEX
|
||
|
|
N SSN,STATE,STREET,ZIP
|
||
|
|
S PID=""
|
||
|
|
S SSN=$P(RM(0),U,4),$P(PID,FS,2)=SSN,$P(PID,FS,19)=SSN
|
||
|
|
S DFN=$P(RM(0),U,3),$P(PID,FS,3)=DFN
|
||
|
|
S PNM=$$HLNAME^HLFNC($P(^DPT(DFN,0),U)),$P(PID,FS,5)=PNM
|
||
|
|
S DOB=$$HLDATE^HLFNC($P(RM(0),U,5)),$P(PID,FS,7)=DOB
|
||
|
|
S CASE=$P(RM(0),U,2),$P(PID,FS,4)=IFN_CS_CASE
|
||
|
|
S STREET=$P(RM(1),U,1)
|
||
|
|
S CITY=$P(RM(1),U,2)
|
||
|
|
S STATE=$P(RM(1),U,3)
|
||
|
|
S ZIP=$P(RM(1),U,4)
|
||
|
|
;S ADDR=$$HLADDR^HLFNC(STREET,CITY_U_STATE_U_ZIP),$P(PID,FS,11)=ADDR
|
||
|
|
S ADDR=STREET_U_U_CITY_U_STATE_U_ZIP_U_"USA",$P(PID,FS,11)=ADDR
|
||
|
|
S PHONE=$$HLPHONE^HLFNC($P(RM(1),U,5)),$P(PID,FS,13)=PHONE
|
||
|
|
S SEX=$P(RM(1),U,6),$P(PID,FS,8)=SEX
|
||
|
|
S RACE=$P(RM(1),U,7),$P(PID,FS,10)=RACE
|
||
|
|
S MARRIED=$P(RM(1),U,8),$P(PID,FS,16)=MARRIED
|
||
|
|
S MIL=$P(RM(1),U,9),$P(PID,FS,27)=MIL
|
||
|
|
Q "PID"_FS_PID
|
||
|
|
OBR() ; KEY FIELDS
|
||
|
|
N ADMIT,ASSDT,CARE,DOB,ETIOL,FAC,IMPAIR,OBR,ONSET,SSN,UNIV
|
||
|
|
S OBR="",UNIV=""
|
||
|
|
S SSN=$P(RM(0),U,4),$P(UNIV,CS)=SSN
|
||
|
|
S DOB=$$HLDATE^HLFNC($P(RM(0),U,5)),$P(UNIV,CS,2)=DOB
|
||
|
|
S CARE=$P(RM(0),U,7),$P(UNIV,CS,3)=$$CCV(CARE)
|
||
|
|
S ONSET=$$HLDATE^HLFNC($P(RM(0),U,9)),$P(UNIV,CS,4)=ONSET
|
||
|
|
S IMPAIR=$P(RM(0),U,8),$P(UNIV,CS,5)=IMPAIR
|
||
|
|
S ADMIT=$$HLDATE^HLFNC($P(RM(0),U,10)),$P(UNIV,CS,6)=ADMIT
|
||
|
|
S FAC=$P(RM(0),U,6)
|
||
|
|
I $L(FAC)<4 S FAC=FAC_" "
|
||
|
|
I $L(FAC)<4 S FAC=FAC_" "
|
||
|
|
S $P(UNIV,CS,7)=FAC
|
||
|
|
S $P(OBR,FS,4)=UNIV
|
||
|
|
S ETIOL=$P(RM(2),U,10),$P(OBR,FS,13)=ETIOL
|
||
|
|
S ASSDT=$$HLDATE^HLFNC($P(RM(0),U,12)),$P(OBR,FS,7)=ASSDT
|
||
|
|
Q "OBR"_FS_OBR
|
||
|
|
PV1() ; EPISODE OF CARE DATA
|
||
|
|
N ADMCL,ADMDT,CARECL,DCDT,PV1
|
||
|
|
S PV1=""
|
||
|
|
S ADMCL=$P(RM(2),U),$P(PV1,FS,4)=ADMCL
|
||
|
|
S CARECL=$P(RM(0),U,7),$P(PV1,FS,2)=$$CCV(CARECL)
|
||
|
|
S ADMDT=$$HLDATE^HLFNC($P(RM(0),U,10)),$P(PV1,FS,44)=ADMDT
|
||
|
|
S DCDT=$$HLDATE^HLFNC($P(RM(0),U,11)),$P(PV1,FS,45)=DCDT
|
||
|
|
Q "PV1"_FS_PV1
|
||
|
|
CCV(X) ; CARE CLASS CONVERSION
|
||
|
|
Q $S(X=1:10,X=2:"04",X=3:"09",1:X)
|
||
|
|
NTE() ; TRANSFERS
|
||
|
|
N COM S COM=""
|
||
|
|
S COM=$P(RM(2),U,4,9)
|
||
|
|
F RM=1:1:6 S $P(COM,U,RM)=$$HLDATE^HLFNC($P(COM,U,RM))
|
||
|
|
S COM=$TR(COM,U,CS)
|
||
|
|
Q "NTE"_FS_"1"_FS_"L"_FS_COM
|
||
|
|
OBXDG() ; DIAGNOSIS CODES
|
||
|
|
N ASIA,ICD,OBX
|
||
|
|
S ASIA=$P(RM(2),U,11),ICD=$TR(RM(3),U,CS)
|
||
|
|
S OBX="1"_FS_"CE"_FS_"DIAGNOSIS CODES"_FS_ASIA_CS_ICD
|
||
|
|
S $P(OBX,FS,11)="F"
|
||
|
|
Q "OBX"_FS_OBX
|
||
|
|
OBXS(T) ; FIM SCORES
|
||
|
|
N OBX,SCORES,TYPE
|
||
|
|
S TYPE=$P(TYPES,U,T),OBX="",SCORES=$TR(RM(T+3),U,CS),$P(OBX,FS,5)=SCORES
|
||
|
|
S $P(OBX,FS,1)=IDX-5,$P(OBX,FS,2)="NM",$P(OBX,FS,3)=TYPE
|
||
|
|
S $P(OBX,FS,11)="F"
|
||
|
|
Q "OBX"_FS_OBX
|
||
|
|
OBXN(X) ; CASE NOTES
|
||
|
|
N OBX S $P(OBX,FS)=HLI,$P(OBX,FS,2)="FT",$P(OBX,FS,3)="CASE NOTES"
|
||
|
|
S $P(OBX,FS,11)="F",$P(OBX,FS,5)=X
|
||
|
|
Q "OBX"_FS_OBX
|
||
|
|
TASK ; NIGHTLY JOB
|
||
|
|
I '$$FIND1^DIC(4.2,"","X","Q-FIM.MED.VA.GOV","B") D Q
|
||
|
|
.N TX,XMDUN,XMDUZ,XMSUB,XMTEXT,XMY,XMZ
|
||
|
|
.S TX(1,0)="The domain Q-FIM.MED.VA.GOV does not exist in your DOMAIN "
|
||
|
|
.S TX(2,0)="file."
|
||
|
|
.S TX(3,0)="Ask your IRM to install patch XM*DBA*150."
|
||
|
|
.S TX(4,0)="You will not be able to transmit data to FSOD until this"
|
||
|
|
.S TX(5,0)="patch has been installed."
|
||
|
|
.S (XMDUN,XMDUZ)="FSOD TRANSMISSION",XMSUB="Missing Domain"
|
||
|
|
.S XMTEXT="TX(",XMY("G.RMIM FSOD")="" D ^XMD
|
||
|
|
S IFN=0 F S IFN=$O(^RMIM(783,"ATRAN",1,IFN)) Q:'IFN D
|
||
|
|
.Q:'$D(^RMIM(783,IFN,0))
|
||
|
|
.S STAT=$$SND(IFN)
|
||
|
|
Q
|