DGROHLU ;DJH/AMA,TDM - ROM HL7 BUILD ORF SEGMENT ; 10/20/10 3:00pm
;;5.3;Registration;**533,572,754,797**;Aug 13, 1993;Build 24
;
Q
;
DIQ(DGROFDA,FILE,DFN,DGQRY) ;GATHER THE PATIENT DATA USING GETS^DIQ
;Called from BLDORF^DGROHLQ
; INPUT:
; DGROFDA = ROOT FILE NAME OF TEMP GLOBAL ARRAY, ^TMP("DGROFDA",$J)
; FILE = FILE FROM WHICH TO GATHER THE DATA
; DFN = POINTER TO PATIENT (#2) FILE
; DGQRY = ARRAY OF PARSED "QRY" DATA ;DG*5.3*572
;
; OUTPUT:
; GLOBAL ARRAY OF REQUESTED DATA ELEMENTS, IN DGROFDA
;
;THIS ROUTINE ALSO CHECKS THE DG REGISTER ONCE FIELD DEFINITION
;(#391.23) FILE TO ENSURE EACH DATA ELEMENT IS REQUESTED.
;
N U,FLAG,FIELD,TMPFLD,F,IEN,CNT,F1,F2,F3,F4,EIEN,STATEIEN,CNTYIEN,CNTY
N CAGET,CANOD,CAACT,CABDT,CAEDT
;
;BUILD THE INITIAL DATA ELEMENT GLOBAL ARRAY
;* County name is sent instead of number (avoid duplicate on number)
;* Direct global reads of STATE file, COUNTY multiple supported with
;* IA #10056
;
S U="^",FLAG="EN" ;*Get External value (DG*5.3*572)
S (STATEIEN,CNTYIEN)=""
S FILE=0
;
;Determine if Confidential Address info should be retreived.
S CAGET=0,CANOD=$G(^DPT(DFN,.141))
S CAACT=$P(CANOD,"^",9),CABDT=$P(CANOD,"^",7),CAEDT=$P(CANOD,"^",8)
I CAACT="Y",+CABDT>0,((CAEDT="")!((CAEDT+1)>DT)) S CAGET=1
;
F S FILE=$O(^DGRO(391.23,"C",FILE)) Q:'FILE D
. I (FILE=2.01)!(FILE=2.02)!(FILE=2.06)!(FILE=2.141)!(FILE=2.11)!(FILE=2.3216) Q
. S FIELD=0
. F S FIELD=$O(^DGRO(391.23,"C",FILE,FIELD)) Q:'FIELD D
. . Q:$$DIS^DGROHLR1(FILE,FIELD)
. . I 'CAGET,FILE=2,((FIELD=.1315)!(FIELD=.14105)!((FIELD>.1410)&(FIELD<.1419))!((FIELD>.14110)&(FIELD<.14117))) Q
. . S (CNTY,CNTYIEN,STATEIEN)=0
. . I FILE=2 DO
. . . I (FIELD=.117),($D(^DPT(DFN,.11))) DO
. . . . S STATEIEN=$P(^DPT(DFN,.11),"^",5)
. . . . S CNTYIEN=$P(^DPT(DFN,.11),"^",7)
. . . . S:((+STATEIEN>0)&(+CNTYIEN>0)) @DGROFDA@(FILE,DFN,FIELD,"E")=$P(^DIC(5,STATEIEN,1,CNTYIEN,0),"^",1)
. . . . S CNTY=1
. . . I (FIELD=.12111),($D(^DPT(DFN,.121))) DO
. . . . S STATEIEN=$P(^DPT(DFN,.121),"^",5)
. . . . S CNTYIEN=$P(^DPT(DFN,.121),"^",11)
. . . . S:((+STATEIEN>0)&(+CNTYIEN>0)) @DGROFDA@(FILE,DFN,FIELD,"E")=$P(^DIC(5,STATEIEN,1,CNTYIEN,0),"^",1)
. . . . S CNTY=1
. . . I (FIELD=.14111),($D(^DPT(DFN,.141))) DO
. . . . S STATEIEN=$P(^DPT(DFN,.141),"^",5)
. . . . S CNTYIEN=$P(^DPT(DFN,.141),"^",11)
. . . . S:((+STATEIEN>0)&(+CNTYIEN>0)) @DGROFDA@(FILE,DFN,FIELD,"E")=$P(^DIC(5,STATEIEN,1,CNTYIEN,0),"^",1)
. . . . S CNTY=1
. . ; Figure out how to skip the following line if CA is skipped
. . D:(CNTY=0) GETS^DIQ(FILE,DFN,FIELD,FLAG,DGROFDA)
;
;IF THERE'S NO DATE OF DEATH, KILL ALL OTHER DoD FIELDS
I '$D(@DGROFDA@(2,DFN_",",.351)) F FIELD=.351:.001:.355 K @DGROFDA@(2,DFN_",",FIELD)
;
;GET INTERNAL AND EXTERNAL VALUES - ALIAS, RACE, AND ETHNICITY SUB-FILES
F FILE=2.01,2.02,2.06,2.141,2.11,2.3216 D
. N SBFL,SBDA,SBFLD
. S FLAG="IEN" ;*Get Internal and External; no Null values (DG*5.3*572)
. S SBFL=FILE-2 I FILE=2.141 S SBFL=.14
. I FILE=2.11 S SBFL=.37
. S SBDA=0 F S SBDA=$O(^DPT(DFN,SBFL,SBDA)) Q:'SBDA D
. . S SBFLD=0 F S SBFLD=$O(^DGRO(391.23,"C",FILE,SBFLD)) Q:'SBFLD D
. . . Q:$$DIS^DGROHLR1(FILE,SBFLD)
. . . D GETS^DIQ(FILE,SBDA_","_DFN,SBFLD,FLAG,DGROFDA)
;ENSURE THE RACE DATA IS ACTIVE
S IEN="" F S IEN=$O(@DGROFDA@(2.02,IEN)) Q:IEN="" D
. N RIEN,MIEN
. S RIEN=$G(@DGROFDA@(2.02,IEN,.01,"I"))
. I $$GET1^DIQ(10,RIEN,200,"I") K @DGROFDA@(2.02,IEN) Q
. K @DGROFDA@(2.02,IEN,.01,"I")
. K @DGROFDA@(2.02,IEN,.02,"I")
;ENSURE THE ETHNICITY DATA IS ACTIVE
S IEN="" F S IEN=$O(@DGROFDA@(2.06,IEN)) Q:IEN="" D
. N EIEN,MIEN
. S EIEN=$G(@DGROFDA@(2.06,IEN,.01,"I"))
. I $$GET1^DIQ(10.2,EIEN,200,"I") K @DGROFDA@(2.06,IEN) Q
. K @DGROFDA@(2.06,IEN,.01,"I")
. K @DGROFDA@(2.06,IEN,.02,"I")
;
;CHECK FOR SENSITIVE PATIENT; IF SO, THEN PUT THE QUERY SITE (QS)
;USER IN THE NEW PERSON (#200) FILE, RECORD THE ACCESS IN THE
;SECURITY LOG, AND SEND A MAIL BULLETIN TO THE ISO. ;DG*5.3*572
I $D(@DGROFDA@(38.1)) D
. N DGREMS,DGREMN,DGUSER
. S DGREMS=$$IEN^XUAF4(DGQRY("SNDFAC")) ;QS Institution File (#4) IEN
. S DGREMN=$P($$NS^XUAF4(DGREMS),U) ;Get QS Station Name
. S DGUSER=$TR(DGQRY("USER"),"~",U) ;Get QS user data
. ;
. ;Build input for New Person File
. ;(format: SSN^Name^Station Name^Station #^Remote DUZ^Phone)
. S DGUSER=$P(DGUSER,U,1,2)_U_DGREMN_U_DGQRY("SNDFAC")_U_$P(DGUSER,U,3,4)
. I '$$PUT^XUESSO1(DGUSER) K @DGROFDA Q
. ;
. S DUZ=$$FIND1^DIC(200,"","",$P(DGUSER,U),"SSN","")
. S EVENT="DGRO ROM QRY/R02 EVENT"
. D SETLOG1^DGSEC(DFN,DUZ,0,U_EVENT) ;Create Security Log entry
. D BULTIN1^DGSEC(DFN,DUZ,U_EVENT) ;Send ISO mail bulletin
Q
;
FDA(DGWRK,DGCURLIN,DGFS,DGCS,DGRS,DGDATA) ;Download patient data from Last Site Treated
;Called from PARSORF^DGROHLQ3
; Input:
; DGWRK - Root global with all of the patient data segments, ^TMP("DGROHL7",$J)
; DGCNT - Counter for the root global subscript
; DGFS - HL7 field separator
; DGCS - HL7 component separator
; DGRS - HL7 repetition separator
;
; Output:
; DGDATA - Root global for the patient data to upload, ^TMP("DGROFDA",$J)
;
N DGSUBS,DGVAL,DGFILE,DGIEN,DGFIELD,DGINT,DGRODA
;
S DGCURLIN=DGCURLIN-1
F S DGCURLIN=$O(@DGWRK@(DGCURLIN)) Q:'DGCURLIN D
. N DGSEG
. S DGSEG=$P(@DGWRK@(DGCURLIN,0),DGFS,2)
. S DGSUBS=$P(DGSEG,DGRS),DGVAL=$P(DGSEG,DGRS,2)
. S DGFILE=$P(DGSUBS,DGCS),DGIEN=$P(DGSUBS,DGCS,2)
. S DGFIELD=$P(DGSUBS,DGCS,3),DGINT=$P(DGVAL,DGCS)
. ;
. I '$D(^DGRO(391.23,"C",DGFILE,DGFIELD)) Q
. N SUB S SUB=$O(^DGRO(391.23,"C",DGFILE,DGFIELD,0)) Q:'SUB
. I $P($G(^DGRO(391.23,SUB,0)),"^",5)=1 Q
. ;
. ;BUILD/STORE EXTERNAL VALUES INTO ;*DG*5.3*572
. ; ^TMP("DGROFDA",$J,FILE,IEN,FIELD,"E")=VALUE
. S @DGDATA@(DGFILE,DGIEN,DGFIELD,"E")=DGINT
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGROHLU 5972 printed Nov 22, 2024@18:05:17 Page 2
DGROHLU ;DJH/AMA,TDM - ROM HL7 BUILD ORF SEGMENT ; 10/20/10 3:00pm
+1 ;;5.3;Registration;**533,572,754,797**;Aug 13, 1993;Build 24
+2 ;
+3 QUIT
+4 ;
DIQ(DGROFDA,FILE,DFN,DGQRY) ;GATHER THE PATIENT DATA USING GETS^DIQ
+1 ;Called from BLDORF^DGROHLQ
+2 ; INPUT:
+3 ; DGROFDA = ROOT FILE NAME OF TEMP GLOBAL ARRAY, ^TMP("DGROFDA",$J)
+4 ; FILE = FILE FROM WHICH TO GATHER THE DATA
+5 ; DFN = POINTER TO PATIENT (#2) FILE
+6 ; DGQRY = ARRAY OF PARSED "QRY" DATA ;DG*5.3*572
+7 ;
+8 ; OUTPUT:
+9 ; GLOBAL ARRAY OF REQUESTED DATA ELEMENTS, IN DGROFDA
+10 ;
+11 ;THIS ROUTINE ALSO CHECKS THE DG REGISTER ONCE FIELD DEFINITION
+12 ;(#391.23) FILE TO ENSURE EACH DATA ELEMENT IS REQUESTED.
+13 ;
+14 NEW U,FLAG,FIELD,TMPFLD,F,IEN,CNT,F1,F2,F3,F4,EIEN,STATEIEN,CNTYIEN,CNTY
+15 NEW CAGET,CANOD,CAACT,CABDT,CAEDT
+16 ;
+17 ;BUILD THE INITIAL DATA ELEMENT GLOBAL ARRAY
+18 ;* County name is sent instead of number (avoid duplicate on number)
+19 ;* Direct global reads of STATE file, COUNTY multiple supported with
+20 ;* IA #10056
+21 ;
+22 ;*Get External value (DG*5.3*572)
SET U="^"
SET FLAG="EN"
+23 SET (STATEIEN,CNTYIEN)=""
+24 SET FILE=0
+25 ;
+26 ;Determine if Confidential Address info should be retreived.
+27 SET CAGET=0
SET CANOD=$GET(^DPT(DFN,.141))
+28 SET CAACT=$PIECE(CANOD,"^",9)
SET CABDT=$PIECE(CANOD,"^",7)
SET CAEDT=$PIECE(CANOD,"^",8)
+29 IF CAACT="Y"
IF +CABDT>0
IF ((CAEDT="")!((CAEDT+1)>DT))
SET CAGET=1
+30 ;
+31 FOR
SET FILE=$ORDER(^DGRO(391.23,"C",FILE))
if 'FILE
QUIT
Begin DoDot:1
+32 IF (FILE=2.01)!(FILE=2.02)!(FILE=2.06)!(FILE=2.141)!(FILE=2.11)!(FILE=2.3216)
QUIT
+33 SET FIELD=0
+34 FOR
SET FIELD=$ORDER(^DGRO(391.23,"C",FILE,FIELD))
if 'FIELD
QUIT
Begin DoDot:2
+35 if $$DIS^DGROHLR1(FILE,FIELD)
QUIT
+36 IF 'CAGET
IF FILE=2
IF ((FIELD=.1315)!(FIELD=.14105)!((FIELD>.1410)&(FIELD<.1419))!((FIELD>.14110)&(FIELD<.14117)))
QUIT
+37 SET (CNTY,CNTYIEN,STATEIEN)=0
+38 IF FILE=2
Begin DoDot:3
+39 IF (FIELD=.117)
IF ($DATA(^DPT(DFN,.11)))
Begin DoDot:4
+40 SET STATEIEN=$PIECE(^DPT(DFN,.11),"^",5)
+41 SET CNTYIEN=$PIECE(^DPT(DFN,.11),"^",7)
+42 if ((+STATEIEN>0)&(+CNTYIEN>0))
SET @DGROFDA@(FILE,DFN,FIELD,"E")=$PIECE(^DIC(5,STATEIEN,1,CNTYIEN,0),"^",1)
+43 SET CNTY=1
End DoDot:4
+44 IF (FIELD=.12111)
IF ($DATA(^DPT(DFN,.121)))
Begin DoDot:4
+45 SET STATEIEN=$PIECE(^DPT(DFN,.121),"^",5)
+46 SET CNTYIEN=$PIECE(^DPT(DFN,.121),"^",11)
+47 if ((+STATEIEN>0)&(+CNTYIEN>0))
SET @DGROFDA@(FILE,DFN,FIELD,"E")=$PIECE(^DIC(5,STATEIEN,1,CNTYIEN,0),"^",1)
+48 SET CNTY=1
End DoDot:4
+49 IF (FIELD=.14111)
IF ($DATA(^DPT(DFN,.141)))
Begin DoDot:4
+50 SET STATEIEN=$PIECE(^DPT(DFN,.141),"^",5)
+51 SET CNTYIEN=$PIECE(^DPT(DFN,.141),"^",11)
+52 if ((+STATEIEN>0)&(+CNTYIEN>0))
SET @DGROFDA@(FILE,DFN,FIELD,"E")=$PIECE(^DIC(5,STATEIEN,1,CNTYIEN,0),"^",1)
+53 SET CNTY=1
End DoDot:4
End DoDot:3
+54 ; Figure out how to skip the following line if CA is skipped
+55 if (CNTY=0)
DO GETS^DIQ(FILE,DFN,FIELD,FLAG,DGROFDA)
End DoDot:2
End DoDot:1
+56 ;
+57 ;IF THERE'S NO DATE OF DEATH, KILL ALL OTHER DoD FIELDS
+58 IF '$DATA(@DGROFDA@(2,DFN_",",.351))
FOR FIELD=.351:.001:.355
KILL @DGROFDA@(2,DFN_",",FIELD)
+59 ;
+60 ;GET INTERNAL AND EXTERNAL VALUES - ALIAS, RACE, AND ETHNICITY SUB-FILES
+61 FOR FILE=2.01,2.02,2.06,2.141,2.11,2.3216
Begin DoDot:1
+62 NEW SBFL,SBDA,SBFLD
+63 ;*Get Internal and External; no Null values (DG*5.3*572)
SET FLAG="IEN"
+64 SET SBFL=FILE-2
IF FILE=2.141
SET SBFL=.14
+65 IF FILE=2.11
SET SBFL=.37
+66 SET SBDA=0
FOR
SET SBDA=$ORDER(^DPT(DFN,SBFL,SBDA))
if 'SBDA
QUIT
Begin DoDot:2
+67 SET SBFLD=0
FOR
SET SBFLD=$ORDER(^DGRO(391.23,"C",FILE,SBFLD))
if 'SBFLD
QUIT
Begin DoDot:3
+68 if $$DIS^DGROHLR1(FILE,SBFLD)
QUIT
+69 DO GETS^DIQ(FILE,SBDA_","_DFN,SBFLD,FLAG,DGROFDA)
End DoDot:3
End DoDot:2
End DoDot:1
+70 ;ENSURE THE RACE DATA IS ACTIVE
+71 SET IEN=""
FOR
SET IEN=$ORDER(@DGROFDA@(2.02,IEN))
if IEN=""
QUIT
Begin DoDot:1
+72 NEW RIEN,MIEN
+73 SET RIEN=$GET(@DGROFDA@(2.02,IEN,.01,"I"))
+74 IF $$GET1^DIQ(10,RIEN,200,"I")
KILL @DGROFDA@(2.02,IEN)
QUIT
+75 KILL @DGROFDA@(2.02,IEN,.01,"I")
+76 KILL @DGROFDA@(2.02,IEN,.02,"I")
End DoDot:1
+77 ;ENSURE THE ETHNICITY DATA IS ACTIVE
+78 SET IEN=""
FOR
SET IEN=$ORDER(@DGROFDA@(2.06,IEN))
if IEN=""
QUIT
Begin DoDot:1
+79 NEW EIEN,MIEN
+80 SET EIEN=$GET(@DGROFDA@(2.06,IEN,.01,"I"))
+81 IF $$GET1^DIQ(10.2,EIEN,200,"I")
KILL @DGROFDA@(2.06,IEN)
QUIT
+82 KILL @DGROFDA@(2.06,IEN,.01,"I")
+83 KILL @DGROFDA@(2.06,IEN,.02,"I")
End DoDot:1
+84 ;
+85 ;CHECK FOR SENSITIVE PATIENT; IF SO, THEN PUT THE QUERY SITE (QS)
+86 ;USER IN THE NEW PERSON (#200) FILE, RECORD THE ACCESS IN THE
+87 ;SECURITY LOG, AND SEND A MAIL BULLETIN TO THE ISO. ;DG*5.3*572
+88 IF $DATA(@DGROFDA@(38.1))
Begin DoDot:1
+89 NEW DGREMS,DGREMN,DGUSER
+90 ;QS Institution File (#4) IEN
SET DGREMS=$$IEN^XUAF4(DGQRY("SNDFAC"))
+91 ;Get QS Station Name
SET DGREMN=$PIECE($$NS^XUAF4(DGREMS),U)
+92 ;Get QS user data
SET DGUSER=$TRANSLATE(DGQRY("USER"),"~",U)
+93 ;
+94 ;Build input for New Person File
+95 ;(format: SSN^Name^Station Name^Station #^Remote DUZ^Phone)
+96 SET DGUSER=$PIECE(DGUSER,U,1,2)_U_DGREMN_U_DGQRY("SNDFAC")_U_$PIECE(DGUSER,U,3,4)
+97 IF '$$PUT^XUESSO1(DGUSER)
KILL @DGROFDA
QUIT
+98 ;
+99 SET DUZ=$$FIND1^DIC(200,"","",$PIECE(DGUSER,U),"SSN","")
+100 SET EVENT="DGRO ROM QRY/R02 EVENT"
+101 ;Create Security Log entry
DO SETLOG1^DGSEC(DFN,DUZ,0,U_EVENT)
+102 ;Send ISO mail bulletin
DO BULTIN1^DGSEC(DFN,DUZ,U_EVENT)
End DoDot:1
+103 QUIT
+104 ;
FDA(DGWRK,DGCURLIN,DGFS,DGCS,DGRS,DGDATA) ;Download patient data from Last Site Treated
+1 ;Called from PARSORF^DGROHLQ3
+2 ; Input:
+3 ; DGWRK - Root global with all of the patient data segments, ^TMP("DGROHL7",$J)
+4 ; DGCNT - Counter for the root global subscript
+5 ; DGFS - HL7 field separator
+6 ; DGCS - HL7 component separator
+7 ; DGRS - HL7 repetition separator
+8 ;
+9 ; Output:
+10 ; DGDATA - Root global for the patient data to upload, ^TMP("DGROFDA",$J)
+11 ;
+12 NEW DGSUBS,DGVAL,DGFILE,DGIEN,DGFIELD,DGINT,DGRODA
+13 ;
+14 SET DGCURLIN=DGCURLIN-1
+15 FOR
SET DGCURLIN=$ORDER(@DGWRK@(DGCURLIN))
if 'DGCURLIN
QUIT
Begin DoDot:1
+16 NEW DGSEG
+17 SET DGSEG=$PIECE(@DGWRK@(DGCURLIN,0),DGFS,2)
+18 SET DGSUBS=$PIECE(DGSEG,DGRS)
SET DGVAL=$PIECE(DGSEG,DGRS,2)
+19 SET DGFILE=$PIECE(DGSUBS,DGCS)
SET DGIEN=$PIECE(DGSUBS,DGCS,2)
+20 SET DGFIELD=$PIECE(DGSUBS,DGCS,3)
SET DGINT=$PIECE(DGVAL,DGCS)
+21 ;
+22 IF '$DATA(^DGRO(391.23,"C",DGFILE,DGFIELD))
QUIT
+23 NEW SUB
SET SUB=$ORDER(^DGRO(391.23,"C",DGFILE,DGFIELD,0))
if 'SUB
QUIT
+24 IF $PIECE($GET(^DGRO(391.23,SUB,0)),"^",5)=1
QUIT
+25 ;
+26 ;BUILD/STORE EXTERNAL VALUES INTO ;*DG*5.3*572
+27 ; ^TMP("DGROFDA",$J,FILE,IEN,FIELD,"E")=VALUE
+28 SET @DGDATA@(DGFILE,DGIEN,DGFIELD,"E")=DGINT
End DoDot:1
+29 QUIT
