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 Apr 09, 2024@20:47:38 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)
