| [613] | 1 | RORUPD52 ;HCIOFO/SG - UPDATE PATIENT'S DEMOGRAPHIC DATA (2) ; 12/12/05 9:19am
|
|---|
| 2 | ;;1.5;CLINICAL CASE REGISTRIES;;Feb 17, 2006
|
|---|
| 3 | ;
|
|---|
| 4 | ; This routine uses the following IAs:
|
|---|
| 5 | ;
|
|---|
| 6 | ; #174 RATED DISBAILITIES (VA) multiple (controlled)
|
|---|
| 7 | ; #2701 $$GETICN^MPIF001 Gets ICN
|
|---|
| 8 | ; #4807 RDIS^DGRPDB (supported)
|
|---|
| 9 | ; #10061 6^VADPT
|
|---|
| 10 | ;
|
|---|
| 11 | Q
|
|---|
| 12 | ;
|
|---|
| 13 | ;***** LOAD DEMOGRAPHIC DATA FROM THE 'PATIENT' FILE
|
|---|
| 14 | ;
|
|---|
| 15 | ; DFN Internal Entry Number in the PATIENT file
|
|---|
| 16 | ;
|
|---|
| 17 | ; .RES Reference to a buffer for the data
|
|---|
| 18 | ;
|
|---|
| 19 | ; RES(1, Demographic and elegibility data
|
|---|
| 20 | ; ^1: SSN .09
|
|---|
| 21 | ; ^2: Date of Birth .03
|
|---|
| 22 | ; ^3: Sex .02
|
|---|
| 23 | ; ^4: Date of Death .351
|
|---|
| 24 | ; ^5: Period of Service .323
|
|---|
| 25 | ; ^6: Service Connected? .301
|
|---|
| 26 | ; ^7: Service Connected Percentage .302
|
|---|
| 27 | ; ^8: ZIP+4 .1112
|
|---|
| 28 | ; ^9: ICN (with the checksum) 991.*
|
|---|
| 29 | ; "FL") List of field numbers separated by the ";"
|
|---|
| 30 | ;
|
|---|
| 31 | ; RES(2) Race and ethnicity data
|
|---|
| 32 | ; Race^Method^...^Ethnicity^Method^...
|
|---|
| 33 | ;
|
|---|
| 34 | ; Return Values:
|
|---|
| 35 | ; <0 Error code
|
|---|
| 36 | ; 0 Ok
|
|---|
| 37 | ;
|
|---|
| 38 | LOADDM(DFN,RES) ;
|
|---|
| 39 | N I,J,VA,VADM,VAEL,VAHOW,VAPA,VAROOT
|
|---|
| 40 | S RES(1,"FL")=".09;.03;.02;.351;.323;.301;.302;.1112;991"
|
|---|
| 41 | D 6^VADPT F I=1,2 S RES(I)=""
|
|---|
| 42 | ;--- Demographic and eligibility fields
|
|---|
| 43 | F I=2,3,5,6 S RES(1)=RES(1)_U_$P($G(VADM(I)),U)
|
|---|
| 44 | S $E(RES(1),1)="" ; Remove the first "^"
|
|---|
| 45 | S I=$G(VAEL(3))
|
|---|
| 46 | S RES(1)=RES(1)_U_$P($G(VAEL(2)),U)_U_$S(I:"Y",1:"N")_U_$P(I,U,2)
|
|---|
| 47 | S I=$$GETICN^MPIF001(DFN)
|
|---|
| 48 | S RES(1)=RES(1)_U_$P($G(VAPA(6)),U,2)_U_$S(I'<0:I,1:"")
|
|---|
| 49 | ;--- Race & Ethnicity
|
|---|
| 50 | F I=11,12 S J="" D
|
|---|
| 51 | . F S J=$O(VADM(I,J)) Q:J="" D
|
|---|
| 52 | . . S RES(2)=RES(2)_U_$P(VADM(I,J),U)_U_$P($G(VADM(I,J,1)),U)
|
|---|
| 53 | S $E(RES(2),1)="" ; Remove the first "^"
|
|---|
| 54 | Q 0
|
|---|
| 55 | ;
|
|---|
| 56 | ;***** LOAD RATED DISABILITIES FROM THE 'PATIENT' FILE
|
|---|
| 57 | ;
|
|---|
| 58 | ; DFN Internal Entry Number in the PATIENT file
|
|---|
| 59 | ;
|
|---|
| 60 | ; .RES Reference to a buffer for the data
|
|---|
| 61 | ;
|
|---|
| 62 | ; RES(3) Rated disabilities data
|
|---|
| 63 | ; Rated Disability^Disability %^Service Connected^...
|
|---|
| 64 | ;
|
|---|
| 65 | ; Return Values:
|
|---|
| 66 | ; <0 Error code
|
|---|
| 67 | ; 0 Ok
|
|---|
| 68 | ;
|
|---|
| 69 | LOADRD(DFN,RES) ;
|
|---|
| 70 | N I,RC,RORBUF
|
|---|
| 71 | S I=0
|
|---|
| 72 | F S I=$O(^DPT(DFN,.372,I)) Q:I'>0 D
|
|---|
| 73 | . S RORBUF(I)=$P($G(^DPT(DFN,.372,I,0)),U,1,3)
|
|---|
| 74 | S RES(3)=$$CRC32^RORBIN("RORBUF")
|
|---|
| 75 | Q 0
|
|---|
| 76 | ; Use this code to load disabilities when the API is fixed.
|
|---|
| 77 | ;S RC=$$RDIS^DGRPDB(DFN,.RORBUF)
|
|---|
| 78 | ;D:'RC ERROR^RORERR(-57,,,DFN,RC,"$$RDIS^DGRPDB")
|
|---|
| 79 | ;
|
|---|
| 80 | ;***** GETS AND PREPARES PATIENT'S DATA
|
|---|
| 81 | ;
|
|---|
| 82 | ; PATIENS Patient IENS in the PATIENT file
|
|---|
| 83 | ; .RORPAT Reference to the FDA for field values
|
|---|
| 84 | ; RORIENS IENS of the record in the ROR PATIENT file
|
|---|
| 85 | ; [.DOD] Date of death is returned via this parameter
|
|---|
| 86 | ;
|
|---|
| 87 | ; Return Values:
|
|---|
| 88 | ; <0 Error code
|
|---|
| 89 | ; 0 Patient data has not been changed
|
|---|
| 90 | ; >0 Data has been changed
|
|---|
| 91 | ;
|
|---|
| 92 | PATDATA(PATIENS,RORPAT,RORIENS,DOD) ;
|
|---|
| 93 | N BUF,DIFCNT,N1,NODE,RC,RORDFN
|
|---|
| 94 | S:PATIENS'["," PATIENS=PATIENS_","
|
|---|
| 95 | S:RORIENS'["," RORIENS=RORIENS_","
|
|---|
| 96 | S RORDFN=$S(RORIENS?1.N1",":+RORIENS,1:-1)
|
|---|
| 97 | S DOD="",(DIFCNT,RC)=0
|
|---|
| 98 | ;--- Load demographic data from the PATIENT file
|
|---|
| 99 | S RC=$$LOADDM(+PATIENS,.NODE) Q:RC<0 RC
|
|---|
| 100 | S DOD=$P(NODE(1),U,4),N1=$L(NODE(1,"FL"),";")
|
|---|
| 101 | ;--- Demographic and eligibility fields
|
|---|
| 102 | S BUF=$P($G(^RORDATA(798.4,RORDFN,1)),U,1,N1)
|
|---|
| 103 | I NODE(1)'=BUF D
|
|---|
| 104 | . N CF,FLD,I
|
|---|
| 105 | . F I=1:1:N1 S FLD=+$P(NODE(1,"FL"),";",I) D:FLD>0
|
|---|
| 106 | . . K RORPAT(798.4,RORIENS,FLD)
|
|---|
| 107 | . . ;--- Update the field if necessary
|
|---|
| 108 | . . S OLDVAL=$P(BUF,U,I) Q:$P(NODE(1),U,I)=OLDVAL
|
|---|
| 109 | . . S RORPAT(798.4,RORIENS,FLD)=$P(NODE(1),U,I),CF=1
|
|---|
| 110 | . . ;--- Save previous values of the special fields
|
|---|
| 111 | . . I FLD=.09 D Q
|
|---|
| 112 | . . . S RORPAT(798.4,RORIENS,10.1)=OLDVAL ; Old SSN
|
|---|
| 113 | . . I FLD=991.01 D Q
|
|---|
| 114 | . . . S RORPAT(798.4,RORIENS,10.2)=OLDVAL ; Old ICN
|
|---|
| 115 | . I $G(CF) S DIFCNT=DIFCNT+1 Q
|
|---|
| 116 | . S $P(^RORDATA(798.4,RORDFN,1),U,N1)=$P(BUF,U,N1)
|
|---|
| 117 | ;--- Race & Ethnicity
|
|---|
| 118 | I NODE(2)'=$G(^RORDATA(798.4,RORDFN,2)) D
|
|---|
| 119 | . S DIFCNT=DIFCNT+1,RORPAT(798.4,RORIENS,2)=NODE(2)
|
|---|
| 120 | K NODE
|
|---|
| 121 | ;--- Rated disabilities
|
|---|
| 122 | S RC=$$LOADRD(+PATIENS,.NODE) Q:RC<0 RC
|
|---|
| 123 | I NODE(3)'=$G(^RORDATA(798.4,RORDFN,3)) D
|
|---|
| 124 | . S DIFCNT=DIFCNT+1,RORPAT(798.4,RORIENS,.3721)=NODE(3)
|
|---|
| 125 | Q $S(RC<0:RC,1:DIFCNT)
|
|---|
