- RORRP020 ;HIOFO/SG,VC - RPC: PATIENT DATA UTILITIES ;4/7/09 9:53am
- ;;1.5;CLINICAL CASE REGISTRIES;**1,8,30**;Feb 17, 2006;Build 37
- ;
- ; This routine uses the following IAs:
- ;
- ; #2051 LIST^DIC (supported)
- ; #2056 GET1^DIQ, GETS^DIQ (supported)
- ; #10061 4^VADPT (supported)
- ;
- ;ROR*1.5*30 OCT 2016 M FERRARESE Changing the dispay for "Sex" to "Birth Sex"
- ;
- ;
- Q
- ;
- ;***** LOADS THE DATA FROM THE 'PATIENT' FILE (#2)
- ;
- ; DFN Patient IEN
- ;
- ; .RORDEM Reference to a local variable where the demographic
- ; information is returned to:
- ;
- ; ^01: Patient IEN (DFN)
- ; ^02: Patient Name
- ; ^03: Date of Birth (FileMan)
- ; ^04: SSN
- ; ^05: Date of Death (FileMan)
- ; ^06: Birth Sex (F/M)
- ;
- ; [.RORADR] Reference to a local variable where the patient's
- ; address is returned to:
- ;
- ; ^01: Address (1)
- ; ^02: Address (2)
- ; ^03: Address (3)
- ; ^04: City
- ; ^05: State (IEN)
- ; ^06: State (Name)
- ; ^07: ZIP
- ; ^08: ZIP+4
- ; ^09: County (IEN)
- ; ^10: County (Name)
- ; ^11: Home Phone
- ;
- ; [.VADM] Reference to a local array that is populated by
- ; the 4^VADM API inside this function
- ;
- ; Return Values:
- ; <0 Error code
- ; 0 Ok
- ;
- LOAD2(DFN,RORDEM,RORADR,VADM) ;
- N I,VA,VAHOW,VAPA,VAROOT D 4^VADPT
- ;--- Demographic information
- S RORDEM=DFN ; DFN
- S $P(RORDEM,U,2)=$G(VADM(1)) ; Name
- S $P(RORDEM,U,3)=$P($G(VADM(3)),U) ; DOB
- S $P(RORDEM,U,4)=$P($G(VADM(2)),U) ; SSN
- S $P(RORDEM,U,5)=$P($G(VADM(6)),U) ; DOD
- S $P(RORDEM,U,6)=$P($G(VADM(5)),U) ; Birth Sex
- ;--- Patient's address
- S RORADR=$G(VAPA(1)) ; Address (1)
- S $P(RORADR,U,2)=$G(VAPA(2)) ; Address (2)
- S $P(RORADR,U,3)=$G(VAPA(3)) ; Address (3)
- S $P(RORADR,U,4)=$G(VAPA(4)) ; City
- S $P(RORADR,U,5)=$P($G(VAPA(5)),U,1) ; State IEN
- S $P(RORADR,U,6)=$P($G(VAPA(5)),U,2) ; State Name
- S $P(RORADR,U,7)=$P($G(VAPA(6)),U,1) ; ZIP
- S $P(RORADR,U,8)=$P($G(VAPA(6)),U,2) ; ZIP+4
- S $P(RORADR,U,9)=$P($G(VAPA(7)),U,1) ; County IEN
- S $P(RORADR,U,10)=$P($G(VAPA(7)),U,2) ; County Name
- S $P(RORADR,U,11)=$G(VAPA(8)) ; Home Phone Number
- Q 0
- ;
- ;***** LOADS THE REGISTRY DATA FOR THE PATIENT
- ;
- ; IEN IEN of the registry record (file #798)
- ;
- ; .ROR8DST Reference to a local variable where the results
- ; are returned to:
- ;
- ; ^01: Date Entered (FileMan)
- ; ^02: Status Code (Field 3, File #798)
- ; ^03: Active (0/1)
- ; ^04: Do not Send (0/1)
- ; ^05: Data Acknowledged Until (FileMan)
- ; ^06: Data Extracted Until (FileMan)
- ; ^07: Date Selected (FileMan)
- ; ^08: Date Confirmed (FileMan)
- ; ^09: Location Selected (Institution Name)
- ; ^10: Description of the Earliest Selection Rule
- ; ^11: reserved
- ; ^12: reserved
- ; ^13: Action Flags (see the description below)
- ;
- ; The Action Flags field indicates the actions that
- ; can be performed on the patient's record in the
- ; registry:
- ;
- ; C CDC form can be edited/printed
- ; D The record can be deleted
- ; E The record can be edited
- ; O Read-only mode
- ;
- ; DOD Date of Death (for deceased patients)
- ;
- ; COMMENT Comment of no more than 100 characters added for
- ; Patch 1.5*8 January, 2009
- ;
- ; Return Values:
- ; <0 Error code
- ; 0 Ok
- ;
- LOAD798(IEN,ROR8DST,DOD) ;
- N FLAGS,IENS,RC,RORBUF,RORMSG,TMP
- S ROR8DST=""
- ;
- ;--- Check if the patient is in the registry
- I (IEN'>0)!($D(^RORDATA(798,+IEN))<10) D Q 0
- . S $P(ROR8DST,U,13)=""
- ;
- ;--- Load values from the registry record
- S IENS=(+IEN)_","
- ;****************************** ONE LINE OF OLD CODE
- ;D GETS^DIQ(798,IENS,"1;2;3;8;9.1;9.2;11","I","RORBUF","RORMSG")
- K RORMSG D GETS^DIQ(798,IENS,"1;2;3;8;9.1;9.2;11;12","I","RORBUF","RORMSG")
- ;Q:$G(DIERR) $$DBS^RORERR("RORMSG",-9,,,798,IENS)
- Q:$G(RORMSG("DIERR")) $$DBS^RORERR("RORMSG",-9,,,798,IENS)
- ;
- ;--- Registry data
- S ROR8DST=$G(RORBUF(798,IENS,1,"I")) ; DATE ENTERED
- S $P(ROR8DST,U,2)=+$G(RORBUF(798,IENS,3,"I")) ; STATUS
- S $P(ROR8DST,U,3)=+$G(RORBUF(798,IENS,8,"I")) ; ACTIVE
- S $P(ROR8DST,U,4)=+$G(RORBUF(798,IENS,11,"I")) ; DON'T SEND
- S $P(ROR8DST,U,5)=$G(RORBUF(798,IENS,9.1,"I")) ; ACKNOWLEDGED UNTIL
- S $P(ROR8DST,U,6)=$G(RORBUF(798,IENS,9.2,"I")) ; EXTRACTED UNTIL
- S $P(ROR8DST,U,8)=$G(RORBUF(798,IENS,2,"I")) ; DATE CONFIRMED
- ; -- ADDED COMMENT
- S $P(ROR8DST,U,14)=$G(RORBUF(798,IENS,12,"I")) ; COMMENT
- ;
- ;--- Earliest selection rule
- S IENS=","_IENS,TMP="@;.01I;1I;2E" K RORBUF
- K RORMSG D LIST^DIC(798.01,IENS,TMP,"PU",1,,,"AD",,,"RORBUF","RORMSG")
- ;Q:$G(DIERR) $$DBS^RORERR("RORMSG",-9,,,798.01,IENS)
- Q:$G(RORMSG("DIERR")) $$DBS^RORERR("RORMSG",-9,,,798.01,IENS)
- I $G(RORBUF("DILIST",0))>0 S RC=0 D Q:RC<0 RC
- . S TMP=$G(RORBUF("DILIST",1,0))
- . S $P(ROR8DST,U,7)=$P(TMP,U,3) ; DATE
- . S $P(ROR8DST,U,9)=$P(TMP,U,4) ; LOCATION
- . S IENS=+$P(TMP,U,2)_","
- . K RORMSG S TMP=$$GET1^DIQ(798.2,IENS,4,,,"RORMSG")
- . ;S:$G(DIERR) RC=$$DBS^RORERR("RORMSG",-9,,,798.2,IENS)
- . S:$G(RORMSG("DIERR")) RC=$$DBS^RORERR("RORMSG",-9,,,798.2,IENS)
- . S $P(ROR8DST,U,10)=TMP ; SELECTION RULE
- ;
- ;--- Action flags
- ; The actions and modes are enabled/disabled according to the
- ; following table:
- ;-----------------------------------------------------;
- ; Actions ; Status of the patient ;
- ; and ;--------------------------------------;
- ; Modes ;Not Added;Pending;Active;Inactive;Dead;
- ;--------------+---------+-------+------+--------+----;
- ; (C)DC ; D ; D ; ; ; ;
- ; (D)elete ; D ; ; ; ; ;
- ; (E)dit ; D ; ; ; ; ;
- ; Read (O)nly ; ; ; ; ; ;
- ;-----------------------------------------------------;
- ; D the action is disabled if at least one of the marked
- ; conditions is true;
- ;
- ; E the action is enabled if at least one of the marked
- ; conditions is true.
- ;---
- D
- . I $P(ROR8DST,U,2)=4 S FLAGS="DE" Q ; Pending
- . S FLAGS="CDE"
- S $P(ROR8DST,U,13)=FLAGS
- Q 0
- ;
- ;***** PERFORMS THE POST-PROCESSING OF THE LISTS
- ;
- ; RESULTS Closed root of the array that contains the
- ; results of the query
- ;
- ; REGIEN Registry IEN
- ;
- ; FLAGS Flags that control the execution
- ;
- ; Return Values:
- ; <0 Error code
- ; 0 Ok
- ;
- POSTPROC(RESULTS,REGIEN,FLAGS) ;
- N BUF,DOD,FNP,FO,IEN,IR,PATIEN,RC,TMP
- S FNP=($TR(FLAGS,"P")'=FLAGS),FO=(FLAGS["O")
- ;--- Process the resulting records
- S (IR,RC)=0
- F S IR=$O(@RESULTS@(IR)) Q:IR'>0 D Q:RC<0
- . S BUF=$G(@RESULTS@(IR,0)),PATIEN=+$P(BUF,U,2)
- . I PATIEN'>0 S PATIEN=+BUF Q:PATIEN'>0
- . ;--- Load the required fields from the PATIENT file
- . Q:$$LOAD2(PATIEN,.BUF)<0
- . S DOD=$P(BUF,U,5)
- . S @RESULTS@(IR,0)=BUF
- . ;--- Add optional registry fields if necessary
- . I FO D Q:RC<0
- . . ;--- Get the IEN of the registry record
- . . S IEN=$$PRRIEN^RORUTL01(PATIEN,REGIEN)
- . . ;--- Try to load the data from the ROR REGISTRY RECORD file
- . . S RC=$$LOAD798(IEN,.BUF,DOD)
- . . S:RC'<0 @RESULTS@(IR,1)="O^"_BUF
- ;---
- Q $S(RC<0:RC,1:0)
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRORRP020 8044 printed Mar 13, 2025@20:47:43 Page 2
- RORRP020 ;HIOFO/SG,VC - RPC: PATIENT DATA UTILITIES ;4/7/09 9:53am
- +1 ;;1.5;CLINICAL CASE REGISTRIES;**1,8,30**;Feb 17, 2006;Build 37
- +2 ;
- +3 ; This routine uses the following IAs:
- +4 ;
- +5 ; #2051 LIST^DIC (supported)
- +6 ; #2056 GET1^DIQ, GETS^DIQ (supported)
- +7 ; #10061 4^VADPT (supported)
- +8 ;
- +9 ;ROR*1.5*30 OCT 2016 M FERRARESE Changing the dispay for "Sex" to "Birth Sex"
- +10 ;
- +11 ;
- +12 QUIT
- +13 ;
- +14 ;***** LOADS THE DATA FROM THE 'PATIENT' FILE (#2)
- +15 ;
- +16 ; DFN Patient IEN
- +17 ;
- +18 ; .RORDEM Reference to a local variable where the demographic
- +19 ; information is returned to:
- +20 ;
- +21 ; ^01: Patient IEN (DFN)
- +22 ; ^02: Patient Name
- +23 ; ^03: Date of Birth (FileMan)
- +24 ; ^04: SSN
- +25 ; ^05: Date of Death (FileMan)
- +26 ; ^06: Birth Sex (F/M)
- +27 ;
- +28 ; [.RORADR] Reference to a local variable where the patient's
- +29 ; address is returned to:
- +30 ;
- +31 ; ^01: Address (1)
- +32 ; ^02: Address (2)
- +33 ; ^03: Address (3)
- +34 ; ^04: City
- +35 ; ^05: State (IEN)
- +36 ; ^06: State (Name)
- +37 ; ^07: ZIP
- +38 ; ^08: ZIP+4
- +39 ; ^09: County (IEN)
- +40 ; ^10: County (Name)
- +41 ; ^11: Home Phone
- +42 ;
- +43 ; [.VADM] Reference to a local array that is populated by
- +44 ; the 4^VADM API inside this function
- +45 ;
- +46 ; Return Values:
- +47 ; <0 Error code
- +48 ; 0 Ok
- +49 ;
- LOAD2(DFN,RORDEM,RORADR,VADM) ;
- +1 NEW I,VA,VAHOW,VAPA,VAROOT
- DO 4^VADPT
- +2 ;--- Demographic information
- +3 ; DFN
- SET RORDEM=DFN
- +4 ; Name
- SET $PIECE(RORDEM,U,2)=$GET(VADM(1))
- +5 ; DOB
- SET $PIECE(RORDEM,U,3)=$PIECE($GET(VADM(3)),U)
- +6 ; SSN
- SET $PIECE(RORDEM,U,4)=$PIECE($GET(VADM(2)),U)
- +7 ; DOD
- SET $PIECE(RORDEM,U,5)=$PIECE($GET(VADM(6)),U)
- +8 ; Birth Sex
- SET $PIECE(RORDEM,U,6)=$PIECE($GET(VADM(5)),U)
- +9 ;--- Patient's address
- +10 ; Address (1)
- SET RORADR=$GET(VAPA(1))
- +11 ; Address (2)
- SET $PIECE(RORADR,U,2)=$GET(VAPA(2))
- +12 ; Address (3)
- SET $PIECE(RORADR,U,3)=$GET(VAPA(3))
- +13 ; City
- SET $PIECE(RORADR,U,4)=$GET(VAPA(4))
- +14 ; State IEN
- SET $PIECE(RORADR,U,5)=$PIECE($GET(VAPA(5)),U,1)
- +15 ; State Name
- SET $PIECE(RORADR,U,6)=$PIECE($GET(VAPA(5)),U,2)
- +16 ; ZIP
- SET $PIECE(RORADR,U,7)=$PIECE($GET(VAPA(6)),U,1)
- +17 ; ZIP+4
- SET $PIECE(RORADR,U,8)=$PIECE($GET(VAPA(6)),U,2)
- +18 ; County IEN
- SET $PIECE(RORADR,U,9)=$PIECE($GET(VAPA(7)),U,1)
- +19 ; County Name
- SET $PIECE(RORADR,U,10)=$PIECE($GET(VAPA(7)),U,2)
- +20 ; Home Phone Number
- SET $PIECE(RORADR,U,11)=$GET(VAPA(8))
- +21 QUIT 0
- +22 ;
- +23 ;***** LOADS THE REGISTRY DATA FOR THE PATIENT
- +24 ;
- +25 ; IEN IEN of the registry record (file #798)
- +26 ;
- +27 ; .ROR8DST Reference to a local variable where the results
- +28 ; are returned to:
- +29 ;
- +30 ; ^01: Date Entered (FileMan)
- +31 ; ^02: Status Code (Field 3, File #798)
- +32 ; ^03: Active (0/1)
- +33 ; ^04: Do not Send (0/1)
- +34 ; ^05: Data Acknowledged Until (FileMan)
- +35 ; ^06: Data Extracted Until (FileMan)
- +36 ; ^07: Date Selected (FileMan)
- +37 ; ^08: Date Confirmed (FileMan)
- +38 ; ^09: Location Selected (Institution Name)
- +39 ; ^10: Description of the Earliest Selection Rule
- +40 ; ^11: reserved
- +41 ; ^12: reserved
- +42 ; ^13: Action Flags (see the description below)
- +43 ;
- +44 ; The Action Flags field indicates the actions that
- +45 ; can be performed on the patient's record in the
- +46 ; registry:
- +47 ;
- +48 ; C CDC form can be edited/printed
- +49 ; D The record can be deleted
- +50 ; E The record can be edited
- +51 ; O Read-only mode
- +52 ;
- +53 ; DOD Date of Death (for deceased patients)
- +54 ;
- +55 ; COMMENT Comment of no more than 100 characters added for
- +56 ; Patch 1.5*8 January, 2009
- +57 ;
- +58 ; Return Values:
- +59 ; <0 Error code
- +60 ; 0 Ok
- +61 ;
- LOAD798(IEN,ROR8DST,DOD) ;
- +1 NEW FLAGS,IENS,RC,RORBUF,RORMSG,TMP
- +2 SET ROR8DST=""
- +3 ;
- +4 ;--- Check if the patient is in the registry
- +5 IF (IEN'>0)!($DATA(^RORDATA(798,+IEN))<10)
- Begin DoDot:1
- +6 SET $PIECE(ROR8DST,U,13)=""
- End DoDot:1
- QUIT 0
- +7 ;
- +8 ;--- Load values from the registry record
- +9 SET IENS=(+IEN)_","
- +10 ;****************************** ONE LINE OF OLD CODE
- +11 ;D GETS^DIQ(798,IENS,"1;2;3;8;9.1;9.2;11","I","RORBUF","RORMSG")
- +12 KILL RORMSG
- DO GETS^DIQ(798,IENS,"1;2;3;8;9.1;9.2;11;12","I","RORBUF","RORMSG")
- +13 ;Q:$G(DIERR) $$DBS^RORERR("RORMSG",-9,,,798,IENS)
- +14 if $GET(RORMSG("DIERR"))
- QUIT $$DBS^RORERR("RORMSG",-9,,,798,IENS)
- +15 ;
- +16 ;--- Registry data
- +17 ; DATE ENTERED
- SET ROR8DST=$GET(RORBUF(798,IENS,1,"I"))
- +18 ; STATUS
- SET $PIECE(ROR8DST,U,2)=+$GET(RORBUF(798,IENS,3,"I"))
- +19 ; ACTIVE
- SET $PIECE(ROR8DST,U,3)=+$GET(RORBUF(798,IENS,8,"I"))
- +20 ; DON'T SEND
- SET $PIECE(ROR8DST,U,4)=+$GET(RORBUF(798,IENS,11,"I"))
- +21 ; ACKNOWLEDGED UNTIL
- SET $PIECE(ROR8DST,U,5)=$GET(RORBUF(798,IENS,9.1,"I"))
- +22 ; EXTRACTED UNTIL
- SET $PIECE(ROR8DST,U,6)=$GET(RORBUF(798,IENS,9.2,"I"))
- +23 ; DATE CONFIRMED
- SET $PIECE(ROR8DST,U,8)=$GET(RORBUF(798,IENS,2,"I"))
- +24 ; -- ADDED COMMENT
- +25 ; COMMENT
- SET $PIECE(ROR8DST,U,14)=$GET(RORBUF(798,IENS,12,"I"))
- +26 ;
- +27 ;--- Earliest selection rule
- +28 SET IENS=","_IENS
- SET TMP="@;.01I;1I;2E"
- KILL RORBUF
- +29 KILL RORMSG
- DO LIST^DIC(798.01,IENS,TMP,"PU",1,,,"AD",,,"RORBUF","RORMSG")
- +30 ;Q:$G(DIERR) $$DBS^RORERR("RORMSG",-9,,,798.01,IENS)
- +31 if $GET(RORMSG("DIERR"))
- QUIT $$DBS^RORERR("RORMSG",-9,,,798.01,IENS)
- +32 IF $GET(RORBUF("DILIST",0))>0
- SET RC=0
- Begin DoDot:1
- +33 SET TMP=$GET(RORBUF("DILIST",1,0))
- +34 ; DATE
- SET $PIECE(ROR8DST,U,7)=$PIECE(TMP,U,3)
- +35 ; LOCATION
- SET $PIECE(ROR8DST,U,9)=$PIECE(TMP,U,4)
- +36 SET IENS=+$PIECE(TMP,U,2)_","
- +37 KILL RORMSG
- SET TMP=$$GET1^DIQ(798.2,IENS,4,,,"RORMSG")
- +38 ;S:$G(DIERR) RC=$$DBS^RORERR("RORMSG",-9,,,798.2,IENS)
- +39 if $GET(RORMSG("DIERR"))
- SET RC=$$DBS^RORERR("RORMSG",-9,,,798.2,IENS)
- +40 ; SELECTION RULE
- SET $PIECE(ROR8DST,U,10)=TMP
- End DoDot:1
- if RC<0
- QUIT RC
- +41 ;
- +42 ;--- Action flags
- +43 ; The actions and modes are enabled/disabled according to the
- +44 ; following table:
- +45 ;-----------------------------------------------------;
- +46 ; Actions ; Status of the patient ;
- +47 ; and ;--------------------------------------;
- +48 ; Modes ;Not Added;Pending;Active;Inactive;Dead;
- +49 ;--------------+---------+-------+------+--------+----;
- +50 ; (C)DC ; D ; D ; ; ; ;
- +51 ; (D)elete ; D ; ; ; ; ;
- +52 ; (E)dit ; D ; ; ; ; ;
- +53 ; Read (O)nly ; ; ; ; ; ;
- +54 ;-----------------------------------------------------;
- +55 ; D the action is disabled if at least one of the marked
- +56 ; conditions is true;
- +57 ;
- +58 ; E the action is enabled if at least one of the marked
- +59 ; conditions is true.
- +60 ;---
- +61 Begin DoDot:1
- +62 ; Pending
- IF $PIECE(ROR8DST,U,2)=4
- SET FLAGS="DE"
- QUIT
- +63 SET FLAGS="CDE"
- End DoDot:1
- +64 SET $PIECE(ROR8DST,U,13)=FLAGS
- +65 QUIT 0
- +66 ;
- +67 ;***** PERFORMS THE POST-PROCESSING OF THE LISTS
- +68 ;
- +69 ; RESULTS Closed root of the array that contains the
- +70 ; results of the query
- +71 ;
- +72 ; REGIEN Registry IEN
- +73 ;
- +74 ; FLAGS Flags that control the execution
- +75 ;
- +76 ; Return Values:
- +77 ; <0 Error code
- +78 ; 0 Ok
- +79 ;
- POSTPROC(RESULTS,REGIEN,FLAGS) ;
- +1 NEW BUF,DOD,FNP,FO,IEN,IR,PATIEN,RC,TMP
- +2 SET FNP=($TRANSLATE(FLAGS,"P")'=FLAGS)
- SET FO=(FLAGS["O")
- +3 ;--- Process the resulting records
- +4 SET (IR,RC)=0
- +5 FOR
- SET IR=$ORDER(@RESULTS@(IR))
- if IR'>0
- QUIT
- Begin DoDot:1
- +6 SET BUF=$GET(@RESULTS@(IR,0))
- SET PATIEN=+$PIECE(BUF,U,2)
- +7 IF PATIEN'>0
- SET PATIEN=+BUF
- if PATIEN'>0
- QUIT
- +8 ;--- Load the required fields from the PATIENT file
- +9 if $$LOAD2(PATIEN,.BUF)<0
- QUIT
- +10 SET DOD=$PIECE(BUF,U,5)
- +11 SET @RESULTS@(IR,0)=BUF
- +12 ;--- Add optional registry fields if necessary
- +13 IF FO
- Begin DoDot:2
- +14 ;--- Get the IEN of the registry record
- +15 SET IEN=$$PRRIEN^RORUTL01(PATIEN,REGIEN)
- +16 ;--- Try to load the data from the ROR REGISTRY RECORD file
- +17 SET RC=$$LOAD798(IEN,.BUF,DOD)
- +18 if RC'<0
- SET @RESULTS@(IR,1)="O^"_BUF
- End DoDot:2
- if RC<0
- QUIT
- End DoDot:1
- if RC<0
- QUIT
- +19 ;---
- +20 QUIT $SELECT(RC<0:RC,1:0)
