RORRP027 ;HCIOFO/SG - RPC: RORICR CDC SAVE ; 10/16/06 1:58pm
;;1.5;CLINICAL CASE REGISTRIES;**1,9**;Feb 17, 2006;Build 1
;
;--------------------------------------------------------------------
; Registry: [VA HIV]
;--------------------------------------------------------------------
; 05/23/2009 BAY/KAM ROR*1.5*9 Remedy Call 319731 Correct AIDS OI
; Checkbox populating incorrectly
; Remove 3 lines
Q
;
;***** AIDS INDICATOR DISEASE (VIII)
AID(IENS) ;
N CODE,RC,TMP
S CODE=+$P(RORDATA(RORPTR),U,2)
Q:CODE'>0 "2^AID"_U_CODE
;--- Initial diagnosis
S RORAILST(CODE)=$P(RORDATA(RORPTR),U,3)
;--- Initial date
S TMP=$$DATE1^RORRP026($P(RORDATA(RORPTR),U,4))
Q:TMP<0 "4^AID"_U_CODE
S $P(RORAILST(CODE),U,2)=TMP
Q 0
;
;***** STORES THE AIDS INDICATOR DICEASES INTO THE FDA
AIDSTORE() ;
N CODE,DATE,DTMIN,II,NODE,RC,TMP
S NODE=$$ROOT^DILFD(799.41,","_IENS,1)
S RC=0,DTMIN=""
;--- Mark the old records for removal
S CODE=0
F S CODE=$O(@NODE@(CODE)) Q:CODE'>0 D:'$D(RORAILST(CODE))
. S RORFDAFI(799.41,CODE_","_IENS,.01)="@"
;--- Prepare the records to be added/updated
S II=+$O(RORIEN(""),-1)
S CODE=0
F S CODE=$O(RORAILST(CODE)) Q:CODE'>0 D
. S DATE=$P(RORAILST(CODE),U,2)
. I DATE>0 S:(DATE<DTMIN)!(DTMIN'>0) DTMIN=DATE
. ;--- Update the record
. I $D(@NODE@(CODE)) D Q
. . S TMP=CODE_","_IENS
. . S RORFDAFI(799.41,TMP,.02)=$P(RORAILST(CODE),U,1)
. . S RORFDAFI(799.41,TMP,.03)=DATE
. ;--- Add the record
. S II=II+1,RORIEN(II)=CODE,TMP="?+"_II_","_IENS
. S RORFDAUP(799.41,TMP,.01)=CODE
. S RORFDAUP(799.41,TMP,.02)=$P(RORAILST(CODE),U,1)
. S RORFDAUP(799.41,TMP,.03)=DATE
;--- Populate the CLINICAL AIDS fields (if they are empty)
;
; Remedy call 319731 two lines removed to not populate the CLINICAL
; AIDS fields unless trigged by an AIDS Indicator Disease (CDC form
; Section VIII)
;---
Q RC
;
;***** CANCELS THE EDITING
; RPC: [RORICR CDC CANCEL]
;
; .RESULTS Reference to a local variable where the results
; are returned to.
;
; REGIEN Registry IEN
;
; PATIEN IEN of the registry patient (DFN)
;
; Return Values:
;
; A negative value of the first "^"-piece of the RESULTS(0)
; indicates an error (see the RPCSTK^RORERR procedure for more
; details).
;
; Otherwise, zero is returned in the RESULTS(0).
;
CANCEL(RESULTS,REGIEN,PATIEN) ;
N IENS,RC,RORERRDL
D CLEAR^RORERR("CANCEL^RORRP027",1) K RESULTS
;--- Check the parameters
S RC=0 D I RC<0 D RPCSTK^RORERR(.RESULTS,RC) Q
. ;--- Registry IEN
. I $G(REGIEN)'>0 D Q
. . S RC=$$ERROR^RORERR(-88,,,,"REGIEN",$G(REGIEN))
. S REGIEN=+REGIEN
. ;--- Patient IEN
. I $G(PATIEN)'>0 D Q
. . S RC=$$ERROR^RORERR(-88,,,,"PATIEN",$G(PATIEN))
. S PATIEN=+PATIEN
;
;--- Get the IENS of the registry record
S IENS=$$PRRIEN^RORUTL01(PATIEN,REGIEN)_","
;
;--- Unlock the records
I IENS>0 D I RC<0 D RPCSTK^RORERR(.RESULTS,RC) Q
. S RC=$$UNLOCK^RORLOCK(799.4,IENS)
S RESULTS(0)=0
Q
;
;***** DEMOGRAPHIC INFORMATION (III)
CDM(IENS) ;
N BUF,RC,TMP
S BUF=RORDATA(RORPTR)
S RC=$$CDCFDA^RORRP026(IENS,"CDM^RORRP026",BUF,.RORFDAFI)
Q:RC RC
;--- Default values
F TMP=9.04,9.08,9.09 S RORFDAFI(799.4,IENS,TMP)=""
;--- Age at diagnosis
S TMP=+$P(BUF,U,3)
I TMP Q:$P(BUF,U,4)'?.2N "4^CDM" D
. S:TMP=1 RORFDAFI(799.4,IENS,9.03)=$P(BUF,U,4)
. S:TMP=2 RORFDAFI(799.4,IENS,9.04)=$P(BUF,U,4)
;--- Country of birth
S TMP=+$P(BUF,U,7)
S:TMP=7 RORFDAFI(799.4,IENS,9.08)=$P(BUF,U,8)
S:TMP=8 RORFDAFI(799.4,IENS,9.09)=$P(BUF,U,8)
Q 0
;
;***** COMMENTS (X)
CMT(IENS) ;
N CNT,NE,PTR,RC,SEG,TMP K RORCMT
;--- Load the comments
S PTR=RORPTR,(CNT,NE,RC)=0
F D Q:RC!(SEG'="CMT") S PTR=$O(RORDATA(PTR)) Q:PTR=""
. S SEG=$P(RORDATA(PTR),U) Q:SEG'="CMT"
. S RORPTR=PTR Q:CNT'<3
. S TMP=$P(RORDATA(RORPTR),U,3)
. S CNT=CNT+1,RORCMT(CNT)=TMP
. S:TMP'="" NE=NE+1
;--- Store the reference into the FDA
S RORFDAFI(799.4,IENS,25)=$S(NE>0:"RORCMT",1:"@")
Q RC
;
;***** CLINICAL STATUS (VIII)
CS(IENS) ;
N RC,TMP
S RC=$$CDCFDA^RORRP026(IENS,"CS^RORRP026",RORDATA(RORPTR),.RORFDAFI)
Q RC
;
;***** PROCESSES THE ERROR(S) AND UNLOCKS THE RECORDS
ERROR(RESULTS,RC) ;
D RPCSTK^RORERR(.RESULTS,RC)
D UNLOCK^RORLOCK(.RORLOCK)
Q
;
;***** FACILITY OF DIAGNOSIS (IV)
FD(IENS) ;
N RC,TMP
S RC=$$CDCFDA^RORRP026(IENS,"FD^RORRP026",RORDATA(RORPTR),.RORFDAFI)
Q RC
;
;***** FORM HEADERS
HDR(IENS) ;
N RC,TMP
S RC=$$CDCFDA^RORRP026(IENS,"HDR^RORRP026",RORDATA(RORPTR),.RORFDAFI)
;--- Person who completed the form
S RORFDAFI(799.4,IENS,9.05)=DUZ
Q RC
;
;***** LABORATORY DATA (VI)
LD1(IENS) ;
N BUF,FLD,DATE,RC,TMP
S BUF=RORDATA(RORPTR)
S RC=$$CDCFDA^RORRP026(IENS,"LD1^RORRP026",BUF,.RORFDAFI)
Q:RC RC
;--- Positive HIV detection test
S FLD=$$PHIVFLD^RORRP026($P(BUF,U,12))
I FLD S RC=0 D Q:RC RC
. S DATE=$$DATE1^RORRP026($P(BUF,U,13))
. I DATE<0 S RC="13^LD1" Q
. S RORFDAFI(799.4,IENS,FLD)=DATE
Q 0
;
LD2(IENS) ;
N RC,TMP
S RC=$$CDCFDA^RORRP026(IENS,"LD2^RORRP026",RORDATA(RORPTR),.RORFDAFI)
Q RC
;
;***** PATIENT HISTORY (V)
PH(IENS) ;
N RC,TMP
S RC=$$CDCFDA^RORRP026(IENS,"PH^RORRP026",RORDATA(RORPTR),.RORFDAFI)
Q RC
;
;***** UPDATES THE CDC DATA
; RPC: [RORICR CDC SAVE]
;
; .RESULTS Reference to a local variable where the results
; are returned to.
;
; REGIEN Registry IEN
;
; PATIEN IEN of the registry patient (DFN)
;
; [FLAGS] Flags that control the execution (can be combined):
; H Update the patient history. If this flag is
; not provided, the PH data segment is ignored.
;
; .RORDATA Reference to a local array that contains the CDC
; data in the same format as the output of the RORICR
; CDC LOAD remote procedure (see the LOADCDC^RORRP025
; and description of the RPC for more details).
;
; NOTE #1: The CS data segment must be always included before the
; AID segments. Otherwise, the latter will be ignored.
;
; NOTE #2: Any AIDS indicator disease, which has empty 3rd piece
; in the corresponding AID segment (or no segment at all),
; will be removed from the patient record.
;
; NOTE #3: There should be at least one empty comment (i.e. the
; "CMT^1" segment) among the data if you want to clear
; the CDC comments. Otherwise, they will not be updated.
;
; Return Values:
;
; A negative value of the first "^"-piece of the RESULTS(0)
; indicates an error (see the RPCSTK^RORERR procedure for more
; details).
;
; Positive value of the first "^"-piece of the RESULTS(0) indicates
; an error in the CDC data. The value is the number of the erroneous
; piece of the data segment whose name is returned in the second
; piece of the RESULTS(0). For example, the "11^CDM" means that the
; 11th piece of the CDM data segment (ONSET OF ILLNESS/AIDS- STATE)
; contains an invalid value.
;
; Otherwise, zero is returned in the RESULTS(0).
;
SAVECDC(RESULTS,REGIEN,PATIEN,FLAGS,RORDATA) ;
N RORAILST ; List of AIDS indicator diseases
N RORCMT ; Buffer for the CDC comments (WP field)
N RORFDAFI ; FDA for FILE^DIE
N RORFDAUP ; FDA for UPDATE^DIE
N RORIEN ; List of IEN's to be assigned
;
N I,IEN,IENS,RC,RORERRDL,RORMSG,RORPTR,SEG,SEGLST
D CLEAR^RORERR("SAVECDC^RORRP027",1)
K RESULTS S (RESULTS(0),RORPTR)=0
;--- Check the parameters
S RC=0 D I RC<0 D ERROR(.RESULTS,RC) Q
. ;--- Registry IEN
. I $G(REGIEN)'>0 D Q
. . S RC=$$ERROR^RORERR(-88,,,,"REGIEN",$G(REGIEN))
. S REGIEN=+REGIEN
. ;--- Patient IEN
. I $G(PATIEN)'>0 D Q
. . S RC=$$ERROR^RORERR(-88,,,,"PATIEN",$G(PATIEN))
. S PATIEN=+PATIEN
. ;--- Flags
. S FLAGS=$$UP^XLFSTR($G(FLAGS))
;
;--- Get IEN of the registry record
S IEN=$$PRRIEN^RORUTL01(PATIEN,REGIEN) Q:IEN'>0
S IENS=IEN_","
S RORLOCK(799.4,IENS)=""
;
;--- Prepare the data
S SEGLST=",HDR,CDM,FD,LD1,LD2,CS,AID,TS1,TS2,CMT,"
S:FLAGS["H" SEGLST=SEGLST_"PH,"
S (RC,RORPTR)=0
F S RORPTR=$O(RORDATA(RORPTR)) Q:RORPTR'>0 D Q:RC
. S SEG=$TR($P(RORDATA(RORPTR),U)," ")
. X:SEGLST[(","_SEG_",") "S RC=$$"_SEG_"(IENS)"
I RC<0 D ERROR(.RESULTS,RC) Q
I RC>0 S RESULTS(0)=RC Q
;
;--- Process the list of AIDS indicator diseases
S RC=$$AIDSTORE()
I RC<0 D ERROR(.RESULTS,RC) Q
;
;--- Update the record(s)
I $D(RORFDAFI)>1 D I RC<0 D ERROR(.RESULTS,RC) Q
. D FILE^DIE(,"RORFDAFI","RORMSG")
. S:$G(DIERR) RC=$$DBS^RORERR("RORMSG",-9,,PATIEN,799.4,IENS)
;--- Add the record(s)
I $D(RORFDAUP)>1 D I RC<0 D ERROR(.RESULTS,RC) Q
. D UPDATE^DIE(,"RORFDAUP","RORIEN","RORMSG")
. S:$G(DIERR) RC=$$DBS^RORERR("RORMSG",-9,,PATIEN,799.4,IENS)
;
;--- Unlock the records
S RC=$$UNLOCK^RORLOCK(.RORLOCK)
I RC<0 D ERROR(.RESULTS,RC) Q
S RESULTS(0)=0
Q
;
;***** TREATMENT/SERVICES REFERRALS (IX)
TS1(IENS) ;
N RC,TMP
S RC=$$CDCFDA^RORRP026(IENS,"TS1^RORRP026",RORDATA(RORPTR),.RORFDAFI)
Q RC
;
TS2(IENS) ;
N RC,TMP
S RC=$$CDCFDA^RORRP026(IENS,"TS2^RORRP026",RORDATA(RORPTR),.RORFDAFI)
Q RC
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRORRP027 9406 printed Dec 13, 2024@01:43:10 Page 2
RORRP027 ;HCIOFO/SG - RPC: RORICR CDC SAVE ; 10/16/06 1:58pm
+1 ;;1.5;CLINICAL CASE REGISTRIES;**1,9**;Feb 17, 2006;Build 1
+2 ;
+3 ;--------------------------------------------------------------------
+4 ; Registry: [VA HIV]
+5 ;--------------------------------------------------------------------
+6 ; 05/23/2009 BAY/KAM ROR*1.5*9 Remedy Call 319731 Correct AIDS OI
+7 ; Checkbox populating incorrectly
+8 ; Remove 3 lines
+9 QUIT
+10 ;
+11 ;***** AIDS INDICATOR DISEASE (VIII)
AID(IENS) ;
+1 NEW CODE,RC,TMP
+2 SET CODE=+$PIECE(RORDATA(RORPTR),U,2)
+3 if CODE'>0
QUIT "2^AID"_U_CODE
+4 ;--- Initial diagnosis
+5 SET RORAILST(CODE)=$PIECE(RORDATA(RORPTR),U,3)
+6 ;--- Initial date
+7 SET TMP=$$DATE1^RORRP026($PIECE(RORDATA(RORPTR),U,4))
+8 if TMP<0
QUIT "4^AID"_U_CODE
+9 SET $PIECE(RORAILST(CODE),U,2)=TMP
+10 QUIT 0
+11 ;
+12 ;***** STORES THE AIDS INDICATOR DICEASES INTO THE FDA
AIDSTORE() ;
+1 NEW CODE,DATE,DTMIN,II,NODE,RC,TMP
+2 SET NODE=$$ROOT^DILFD(799.41,","_IENS,1)
+3 SET RC=0
SET DTMIN=""
+4 ;--- Mark the old records for removal
+5 SET CODE=0
+6 FOR
SET CODE=$ORDER(@NODE@(CODE))
if CODE'>0
QUIT
if '$DATA(RORAILST(CODE))
Begin DoDot:1
+7 SET RORFDAFI(799.41,CODE_","_IENS,.01)="@"
End DoDot:1
+8 ;--- Prepare the records to be added/updated
+9 SET II=+$ORDER(RORIEN(""),-1)
+10 SET CODE=0
+11 FOR
SET CODE=$ORDER(RORAILST(CODE))
if CODE'>0
QUIT
Begin DoDot:1
+12 SET DATE=$PIECE(RORAILST(CODE),U,2)
+13 IF DATE>0
if (DATE<DTMIN)!(DTMIN'>0)
SET DTMIN=DATE
+14 ;--- Update the record
+15 IF $DATA(@NODE@(CODE))
Begin DoDot:2
+16 SET TMP=CODE_","_IENS
+17 SET RORFDAFI(799.41,TMP,.02)=$PIECE(RORAILST(CODE),U,1)
+18 SET RORFDAFI(799.41,TMP,.03)=DATE
End DoDot:2
QUIT
+19 ;--- Add the record
+20 SET II=II+1
SET RORIEN(II)=CODE
SET TMP="?+"_II_","_IENS
+21 SET RORFDAUP(799.41,TMP,.01)=CODE
+22 SET RORFDAUP(799.41,TMP,.02)=$PIECE(RORAILST(CODE),U,1)
+23 SET RORFDAUP(799.41,TMP,.03)=DATE
End DoDot:1
+24 ;--- Populate the CLINICAL AIDS fields (if they are empty)
+25 ;
+26 ; Remedy call 319731 two lines removed to not populate the CLINICAL
+27 ; AIDS fields unless trigged by an AIDS Indicator Disease (CDC form
+28 ; Section VIII)
+29 ;---
+30 QUIT RC
+31 ;
+32 ;***** CANCELS THE EDITING
+33 ; RPC: [RORICR CDC CANCEL]
+34 ;
+35 ; .RESULTS Reference to a local variable where the results
+36 ; are returned to.
+37 ;
+38 ; REGIEN Registry IEN
+39 ;
+40 ; PATIEN IEN of the registry patient (DFN)
+41 ;
+42 ; Return Values:
+43 ;
+44 ; A negative value of the first "^"-piece of the RESULTS(0)
+45 ; indicates an error (see the RPCSTK^RORERR procedure for more
+46 ; details).
+47 ;
+48 ; Otherwise, zero is returned in the RESULTS(0).
+49 ;
CANCEL(RESULTS,REGIEN,PATIEN) ;
+1 NEW IENS,RC,RORERRDL
+2 DO CLEAR^RORERR("CANCEL^RORRP027",1)
KILL RESULTS
+3 ;--- Check the parameters
+4 SET RC=0
Begin DoDot:1
+5 ;--- Registry IEN
+6 IF $GET(REGIEN)'>0
Begin DoDot:2
+7 SET RC=$$ERROR^RORERR(-88,,,,"REGIEN",$GET(REGIEN))
End DoDot:2
QUIT
+8 SET REGIEN=+REGIEN
+9 ;--- Patient IEN
+10 IF $GET(PATIEN)'>0
Begin DoDot:2
+11 SET RC=$$ERROR^RORERR(-88,,,,"PATIEN",$GET(PATIEN))
End DoDot:2
QUIT
+12 SET PATIEN=+PATIEN
End DoDot:1
IF RC<0
DO RPCSTK^RORERR(.RESULTS,RC)
QUIT
+13 ;
+14 ;--- Get the IENS of the registry record
+15 SET IENS=$$PRRIEN^RORUTL01(PATIEN,REGIEN)_","
+16 ;
+17 ;--- Unlock the records
+18 IF IENS>0
Begin DoDot:1
+19 SET RC=$$UNLOCK^RORLOCK(799.4,IENS)
End DoDot:1
IF RC<0
DO RPCSTK^RORERR(.RESULTS,RC)
QUIT
+20 SET RESULTS(0)=0
+21 QUIT
+22 ;
+23 ;***** DEMOGRAPHIC INFORMATION (III)
CDM(IENS) ;
+1 NEW BUF,RC,TMP
+2 SET BUF=RORDATA(RORPTR)
+3 SET RC=$$CDCFDA^RORRP026(IENS,"CDM^RORRP026",BUF,.RORFDAFI)
+4 if RC
QUIT RC
+5 ;--- Default values
+6 FOR TMP=9.04,9.08,9.09
SET RORFDAFI(799.4,IENS,TMP)=""
+7 ;--- Age at diagnosis
+8 SET TMP=+$PIECE(BUF,U,3)
+9 IF TMP
if $PIECE(BUF,U,4)'?.2N
QUIT "4^CDM"
Begin DoDot:1
+10 if TMP=1
SET RORFDAFI(799.4,IENS,9.03)=$PIECE(BUF,U,4)
+11 if TMP=2
SET RORFDAFI(799.4,IENS,9.04)=$PIECE(BUF,U,4)
End DoDot:1
+12 ;--- Country of birth
+13 SET TMP=+$PIECE(BUF,U,7)
+14 if TMP=7
SET RORFDAFI(799.4,IENS,9.08)=$PIECE(BUF,U,8)
+15 if TMP=8
SET RORFDAFI(799.4,IENS,9.09)=$PIECE(BUF,U,8)
+16 QUIT 0
+17 ;
+18 ;***** COMMENTS (X)
CMT(IENS) ;
+1 NEW CNT,NE,PTR,RC,SEG,TMP
KILL RORCMT
+2 ;--- Load the comments
+3 SET PTR=RORPTR
SET (CNT,NE,RC)=0
+4 FOR
Begin DoDot:1
+5 SET SEG=$PIECE(RORDATA(PTR),U)
if SEG'="CMT"
QUIT
+6 SET RORPTR=PTR
if CNT'<3
QUIT
+7 SET TMP=$PIECE(RORDATA(RORPTR),U,3)
+8 SET CNT=CNT+1
SET RORCMT(CNT)=TMP
+9 if TMP'=""
SET NE=NE+1
End DoDot:1
if RC!(SEG'="CMT")
QUIT
SET PTR=$ORDER(RORDATA(PTR))
if PTR=""
QUIT
+10 ;--- Store the reference into the FDA
+11 SET RORFDAFI(799.4,IENS,25)=$SELECT(NE>0:"RORCMT",1:"@")
+12 QUIT RC
+13 ;
+14 ;***** CLINICAL STATUS (VIII)
CS(IENS) ;
+1 NEW RC,TMP
+2 SET RC=$$CDCFDA^RORRP026(IENS,"CS^RORRP026",RORDATA(RORPTR),.RORFDAFI)
+3 QUIT RC
+4 ;
+5 ;***** PROCESSES THE ERROR(S) AND UNLOCKS THE RECORDS
ERROR(RESULTS,RC) ;
+1 DO RPCSTK^RORERR(.RESULTS,RC)
+2 DO UNLOCK^RORLOCK(.RORLOCK)
+3 QUIT
+4 ;
+5 ;***** FACILITY OF DIAGNOSIS (IV)
FD(IENS) ;
+1 NEW RC,TMP
+2 SET RC=$$CDCFDA^RORRP026(IENS,"FD^RORRP026",RORDATA(RORPTR),.RORFDAFI)
+3 QUIT RC
+4 ;
+5 ;***** FORM HEADERS
HDR(IENS) ;
+1 NEW RC,TMP
+2 SET RC=$$CDCFDA^RORRP026(IENS,"HDR^RORRP026",RORDATA(RORPTR),.RORFDAFI)
+3 ;--- Person who completed the form
+4 SET RORFDAFI(799.4,IENS,9.05)=DUZ
+5 QUIT RC
+6 ;
+7 ;***** LABORATORY DATA (VI)
LD1(IENS) ;
+1 NEW BUF,FLD,DATE,RC,TMP
+2 SET BUF=RORDATA(RORPTR)
+3 SET RC=$$CDCFDA^RORRP026(IENS,"LD1^RORRP026",BUF,.RORFDAFI)
+4 if RC
QUIT RC
+5 ;--- Positive HIV detection test
+6 SET FLD=$$PHIVFLD^RORRP026($PIECE(BUF,U,12))
+7 IF FLD
SET RC=0
Begin DoDot:1
+8 SET DATE=$$DATE1^RORRP026($PIECE(BUF,U,13))
+9 IF DATE<0
SET RC="13^LD1"
QUIT
+10 SET RORFDAFI(799.4,IENS,FLD)=DATE
End DoDot:1
if RC
QUIT RC
+11 QUIT 0
+12 ;
LD2(IENS) ;
+1 NEW RC,TMP
+2 SET RC=$$CDCFDA^RORRP026(IENS,"LD2^RORRP026",RORDATA(RORPTR),.RORFDAFI)
+3 QUIT RC
+4 ;
+5 ;***** PATIENT HISTORY (V)
PH(IENS) ;
+1 NEW RC,TMP
+2 SET RC=$$CDCFDA^RORRP026(IENS,"PH^RORRP026",RORDATA(RORPTR),.RORFDAFI)
+3 QUIT RC
+4 ;
+5 ;***** UPDATES THE CDC DATA
+6 ; RPC: [RORICR CDC SAVE]
+7 ;
+8 ; .RESULTS Reference to a local variable where the results
+9 ; are returned to.
+10 ;
+11 ; REGIEN Registry IEN
+12 ;
+13 ; PATIEN IEN of the registry patient (DFN)
+14 ;
+15 ; [FLAGS] Flags that control the execution (can be combined):
+16 ; H Update the patient history. If this flag is
+17 ; not provided, the PH data segment is ignored.
+18 ;
+19 ; .RORDATA Reference to a local array that contains the CDC
+20 ; data in the same format as the output of the RORICR
+21 ; CDC LOAD remote procedure (see the LOADCDC^RORRP025
+22 ; and description of the RPC for more details).
+23 ;
+24 ; NOTE #1: The CS data segment must be always included before the
+25 ; AID segments. Otherwise, the latter will be ignored.
+26 ;
+27 ; NOTE #2: Any AIDS indicator disease, which has empty 3rd piece
+28 ; in the corresponding AID segment (or no segment at all),
+29 ; will be removed from the patient record.
+30 ;
+31 ; NOTE #3: There should be at least one empty comment (i.e. the
+32 ; "CMT^1" segment) among the data if you want to clear
+33 ; the CDC comments. Otherwise, they will not be updated.
+34 ;
+35 ; Return Values:
+36 ;
+37 ; A negative value of the first "^"-piece of the RESULTS(0)
+38 ; indicates an error (see the RPCSTK^RORERR procedure for more
+39 ; details).
+40 ;
+41 ; Positive value of the first "^"-piece of the RESULTS(0) indicates
+42 ; an error in the CDC data. The value is the number of the erroneous
+43 ; piece of the data segment whose name is returned in the second
+44 ; piece of the RESULTS(0). For example, the "11^CDM" means that the
+45 ; 11th piece of the CDM data segment (ONSET OF ILLNESS/AIDS- STATE)
+46 ; contains an invalid value.
+47 ;
+48 ; Otherwise, zero is returned in the RESULTS(0).
+49 ;
SAVECDC(RESULTS,REGIEN,PATIEN,FLAGS,RORDATA) ;
+1 ; List of AIDS indicator diseases
NEW RORAILST
+2 ; Buffer for the CDC comments (WP field)
NEW RORCMT
+3 ; FDA for FILE^DIE
NEW RORFDAFI
+4 ; FDA for UPDATE^DIE
NEW RORFDAUP
+5 ; List of IEN's to be assigned
NEW RORIEN
+6 ;
+7 NEW I,IEN,IENS,RC,RORERRDL,RORMSG,RORPTR,SEG,SEGLST
+8 DO CLEAR^RORERR("SAVECDC^RORRP027",1)
+9 KILL RESULTS
SET (RESULTS(0),RORPTR)=0
+10 ;--- Check the parameters
+11 SET RC=0
Begin DoDot:1
+12 ;--- Registry IEN
+13 IF $GET(REGIEN)'>0
Begin DoDot:2
+14 SET RC=$$ERROR^RORERR(-88,,,,"REGIEN",$GET(REGIEN))
End DoDot:2
QUIT
+15 SET REGIEN=+REGIEN
+16 ;--- Patient IEN
+17 IF $GET(PATIEN)'>0
Begin DoDot:2
+18 SET RC=$$ERROR^RORERR(-88,,,,"PATIEN",$GET(PATIEN))
End DoDot:2
QUIT
+19 SET PATIEN=+PATIEN
+20 ;--- Flags
+21 SET FLAGS=$$UP^XLFSTR($GET(FLAGS))
End DoDot:1
IF RC<0
DO ERROR(.RESULTS,RC)
QUIT
+22 ;
+23 ;--- Get IEN of the registry record
+24 SET IEN=$$PRRIEN^RORUTL01(PATIEN,REGIEN)
if IEN'>0
QUIT
+25 SET IENS=IEN_","
+26 SET RORLOCK(799.4,IENS)=""
+27 ;
+28 ;--- Prepare the data
+29 SET SEGLST=",HDR,CDM,FD,LD1,LD2,CS,AID,TS1,TS2,CMT,"
+30 if FLAGS["H"
SET SEGLST=SEGLST_"PH,"
+31 SET (RC,RORPTR)=0
+32 FOR
SET RORPTR=$ORDER(RORDATA(RORPTR))
if RORPTR'>0
QUIT
Begin DoDot:1
+33 SET SEG=$TRANSLATE($PIECE(RORDATA(RORPTR),U)," ")
+34 if SEGLST[(","_SEG_",")
XECUTE "S RC=$$"_SEG_"(IENS)"
End DoDot:1
if RC
QUIT
+35 IF RC<0
DO ERROR(.RESULTS,RC)
QUIT
+36 IF RC>0
SET RESULTS(0)=RC
QUIT
+37 ;
+38 ;--- Process the list of AIDS indicator diseases
+39 SET RC=$$AIDSTORE()
+40 IF RC<0
DO ERROR(.RESULTS,RC)
QUIT
+41 ;
+42 ;--- Update the record(s)
+43 IF $DATA(RORFDAFI)>1
Begin DoDot:1
+44 DO FILE^DIE(,"RORFDAFI","RORMSG")
+45 if $GET(DIERR)
SET RC=$$DBS^RORERR("RORMSG",-9,,PATIEN,799.4,IENS)
End DoDot:1
IF RC<0
DO ERROR(.RESULTS,RC)
QUIT
+46 ;--- Add the record(s)
+47 IF $DATA(RORFDAUP)>1
Begin DoDot:1
+48 DO UPDATE^DIE(,"RORFDAUP","RORIEN","RORMSG")
+49 if $GET(DIERR)
SET RC=$$DBS^RORERR("RORMSG",-9,,PATIEN,799.4,IENS)
End DoDot:1
IF RC<0
DO ERROR(.RESULTS,RC)
QUIT
+50 ;
+51 ;--- Unlock the records
+52 SET RC=$$UNLOCK^RORLOCK(.RORLOCK)
+53 IF RC<0
DO ERROR(.RESULTS,RC)
QUIT
+54 SET RESULTS(0)=0
+55 QUIT
+56 ;
+57 ;***** TREATMENT/SERVICES REFERRALS (IX)
TS1(IENS) ;
+1 NEW RC,TMP
+2 SET RC=$$CDCFDA^RORRP026(IENS,"TS1^RORRP026",RORDATA(RORPTR),.RORFDAFI)
+3 QUIT RC
+4 ;
TS2(IENS) ;
+1 NEW RC,TMP
+2 SET RC=$$CDCFDA^RORRP026(IENS,"TS2^RORRP026",RORDATA(RORPTR),.RORFDAFI)
+3 QUIT RC
