Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: RORUPD52

RORUPD52.m

Go to the documentation of this file.
  1. RORUPD52 ;HCIOFO/SG - UPDATE PATIENT'S DEMOGRAPHIC DATA (2) ; 12/12/05 9:19am
  1. ;;1.5;CLINICAL CASE REGISTRIES;**30**;Feb 17, 2006;Build 37
  1. ;
  1. ; This routine uses the following IAs:
  1. ;
  1. ; #174 RATED DISBAILITIES (VA) multiple (controlled)
  1. ; #2701 $$GETICN^MPIF001 Gets ICN
  1. ; #4807 RDIS^DGRPDB (supported)
  1. ; #10061 6^VADPT
  1. ;
  1. ;ROR*1.5*30 OCT 2016 M FERRARESE Changing the dispay for "Sex" to "Birth Sex"
  1. ;
  1. Q
  1. ;
  1. ;***** LOAD DEMOGRAPHIC DATA FROM THE 'PATIENT' FILE
  1. ;
  1. ; DFN Internal Entry Number in the PATIENT file
  1. ;
  1. ; .RES Reference to a buffer for the data
  1. ;
  1. ; RES(1, Demographic and elegibility data
  1. ; ^1: SSN .09
  1. ; ^2: Date of Birth .03
  1. ; ^3: Birth Sex .02
  1. ; ^4: Date of Death .351
  1. ; ^5: Period of Service .323
  1. ; ^6: Service Connected? .301
  1. ; ^7: Service Connected Percentage .302
  1. ; ^8: ZIP+4 .1112
  1. ; ^9: ICN (with the checksum) 991.*
  1. ; "FL") List of field numbers separated by the ";"
  1. ;
  1. ; RES(2) Race and ethnicity data
  1. ; Race^Method^...^Ethnicity^Method^...
  1. ;
  1. ; Return Values:
  1. ; <0 Error code
  1. ; 0 Ok
  1. ;
  1. LOADDM(DFN,RES) ;
  1. N I,J,VA,VADM,VAEL,VAHOW,VAPA,VAROOT
  1. S RES(1,"FL")=".09;.03;.02;.351;.323;.301;.302;.1112;991"
  1. D 6^VADPT F I=1,2 S RES(I)=""
  1. ;--- Demographic and eligibility fields
  1. F I=2,3,5,6 S RES(1)=RES(1)_U_$P($G(VADM(I)),U)
  1. S $E(RES(1),1)="" ; Remove the first "^"
  1. S I=$G(VAEL(3))
  1. S RES(1)=RES(1)_U_$P($G(VAEL(2)),U)_U_$S(I:"Y",1:"N")_U_$P(I,U,2)
  1. S I=$$GETICN^MPIF001(DFN)
  1. S RES(1)=RES(1)_U_$P($G(VAPA(6)),U,2)_U_$S(I'<0:I,1:"")
  1. ;--- Race & Ethnicity
  1. F I=11,12 S J="" D
  1. . F S J=$O(VADM(I,J)) Q:J="" D
  1. . . S RES(2)=RES(2)_U_$P(VADM(I,J),U)_U_$P($G(VADM(I,J,1)),U)
  1. S $E(RES(2),1)="" ; Remove the first "^"
  1. Q 0
  1. ;
  1. ;***** LOAD RATED DISABILITIES FROM THE 'PATIENT' FILE
  1. ;
  1. ; DFN Internal Entry Number in the PATIENT file
  1. ;
  1. ; .RES Reference to a buffer for the data
  1. ;
  1. ; RES(3) Rated disabilities data
  1. ; Rated Disability^Disability %^Service Connected^...
  1. ;
  1. ; Return Values:
  1. ; <0 Error code
  1. ; 0 Ok
  1. ;
  1. LOADRD(DFN,RES) ;
  1. N I,RC,RORBUF
  1. S I=0
  1. F S I=$O(^DPT(DFN,.372,I)) Q:I'>0 D
  1. . S RORBUF(I)=$P($G(^DPT(DFN,.372,I,0)),U,1,3)
  1. S RES(3)=$$CRC32^RORBIN("RORBUF")
  1. Q 0
  1. ; Use this code to load disabilities when the API is fixed.
  1. ;S RC=$$RDIS^DGRPDB(DFN,.RORBUF)
  1. ;D:'RC ERROR^RORERR(-57,,,DFN,RC,"$$RDIS^DGRPDB")
  1. ;
  1. ;***** GETS AND PREPARES PATIENT'S DATA
  1. ;
  1. ; PATIENS Patient IENS in the PATIENT file
  1. ; .RORPAT Reference to the FDA for field values
  1. ; RORIENS IENS of the record in the ROR PATIENT file
  1. ; [.DOD] Date of death is returned via this parameter
  1. ;
  1. ; Return Values:
  1. ; <0 Error code
  1. ; 0 Patient data has not been changed
  1. ; >0 Data has been changed
  1. ;
  1. PATDATA(PATIENS,RORPAT,RORIENS,DOD) ;
  1. N BUF,DIFCNT,N1,NODE,RC,RORDFN
  1. S:PATIENS'["," PATIENS=PATIENS_","
  1. S:RORIENS'["," RORIENS=RORIENS_","
  1. S RORDFN=$S(RORIENS?1.N1",":+RORIENS,1:-1)
  1. S DOD="",(DIFCNT,RC)=0
  1. ;--- Load demographic data from the PATIENT file
  1. S RC=$$LOADDM(+PATIENS,.NODE) Q:RC<0 RC
  1. S DOD=$P(NODE(1),U,4),N1=$L(NODE(1,"FL"),";")
  1. ;--- Demographic and eligibility fields
  1. S BUF=$P($G(^RORDATA(798.4,RORDFN,1)),U,1,N1)
  1. I NODE(1)'=BUF D
  1. . N CF,FLD,I
  1. . F I=1:1:N1 S FLD=+$P(NODE(1,"FL"),";",I) D:FLD>0
  1. . . K RORPAT(798.4,RORIENS,FLD)
  1. . . ;--- Update the field if necessary
  1. . . S OLDVAL=$P(BUF,U,I) Q:$P(NODE(1),U,I)=OLDVAL
  1. . . S RORPAT(798.4,RORIENS,FLD)=$P(NODE(1),U,I),CF=1
  1. . . ;--- Save previous values of the special fields
  1. . . I FLD=.09 D Q
  1. . . . S RORPAT(798.4,RORIENS,10.1)=OLDVAL ; Old SSN
  1. . . I FLD=991.01 D Q
  1. . . . S RORPAT(798.4,RORIENS,10.2)=OLDVAL ; Old ICN
  1. . I $G(CF) S DIFCNT=DIFCNT+1 Q
  1. . S $P(^RORDATA(798.4,RORDFN,1),U,N1)=$P(BUF,U,N1)
  1. ;--- Race & Ethnicity
  1. I NODE(2)'=$G(^RORDATA(798.4,RORDFN,2)) D
  1. . S DIFCNT=DIFCNT+1,RORPAT(798.4,RORIENS,2)=NODE(2)
  1. K NODE
  1. ;--- Rated disabilities
  1. S RC=$$LOADRD(+PATIENS,.NODE) Q:RC<0 RC
  1. I NODE(3)'=$G(^RORDATA(798.4,RORDFN,3)) D
  1. . S DIFCNT=DIFCNT+1,RORPAT(798.4,RORIENS,.3721)=NODE(3)
  1. Q $S(RC<0:RC,1:DIFCNT)