251 lines
7.8 KiB
Mathematica
251 lines
7.8 KiB
Mathematica
RORUTL17 ;HCIOFO/SG - REGISTRY INFORMATION UTILITIES ; 8/25/05 1:44pm
|
|
;;1.5;CLINICAL CASE REGISTRIES;;Feb 17, 2006
|
|
;
|
|
Q
|
|
;
|
|
;***** ADDS THE PENDING PATIENT TO THE LIST
|
|
;
|
|
; REGIEN Registry IEN
|
|
; IEN IEN of the registry record
|
|
; PATIEN Patient IEN (DFN)
|
|
;
|
|
; Return Values:
|
|
; <0 Error code
|
|
; 0 Ok
|
|
;
|
|
ADDPP(REGIEN,IEN,PATIEN) ;
|
|
N BUF,I,NODE,IEN1,TMP,VA,VADM
|
|
D VADEM^RORUTL05(PATIEN)
|
|
S @ROR8DST@("PPL",PATIEN)=IEN_U_$$XOR^RORUTL03($P($G(VADM(2)),U))
|
|
;--- Dates of selection rules
|
|
S NODE=$$ROOT^DILFD(798.01,","_IEN_",",1),BUF=""
|
|
S IEN1=0
|
|
F S IEN1=$O(@NODE@(IEN1)) Q:IEN1'>0 D
|
|
. S TMP=$G(@NODE@(IEN1,0)),I=+$G(RORSRL(+TMP))
|
|
. S:I>0 $P(BUF,U,I)=$P(TMP,U,2)
|
|
S @ROR8DST@("PPL",PATIEN,1)=BUF
|
|
Q 0
|
|
;
|
|
;***** FORMATS THE DATE
|
|
DATE(DATE) ;
|
|
Q $S(DATE>1:$$FMTE^XLFDT(DATE\1,"5Z"),1:"")
|
|
;
|
|
;***** LOADS THE LIST OF SELECTION RULES
|
|
;
|
|
; REGIEN Registry IEN
|
|
; .SRLST Reference to a local variable for the
|
|
; list of selection rules
|
|
;
|
|
; Return Values:
|
|
; <0 Error code
|
|
; 0 Ok
|
|
;
|
|
LOADSRL(REGIEN,SRLST) ;
|
|
N IEN,NAME,NODE
|
|
S NODE=$$ROOT^DILFD(798.2,,1)
|
|
S IEN=0
|
|
F S IEN=$O(@NODE@(IEN)) Q:IEN'>0 D
|
|
. S NAME=$P($G(@NODE@(IEN,0)),U) Q:NAME=""
|
|
. I NAME?1"VA"1.E1"LAB".E S SRLST(IEN)="1^LAB" Q
|
|
. I NAME?1"VA"1.E1"PROBLEM".E S SRLST(IEN)="2^PROBLEM" Q
|
|
. I NAME?1"VA"1.E1"PTF".E S SRLST(IEN)="3^PTF" Q
|
|
. I NAME?1"VA"1.E1"VPOV".E S SRLST(IEN)="4^VISIT" Q
|
|
. I NAME?1"VA"1.E1"VISIT".E S SRLST(IEN)="4^VISIT" Q
|
|
Q 0
|
|
;
|
|
;***** COUNTS PATIENTS WITH ERRORS
|
|
;
|
|
; REGIEN Registry IEN
|
|
;
|
|
; Return Values:
|
|
; <0 Error code
|
|
; 0 Ok
|
|
; >0 Number of patients with errors
|
|
;
|
|
PTERR(REGIEN,SPI) ;
|
|
N CNT,IEN,NODE,RC,TMP
|
|
W:SPI !,"Counting patients with errors",!
|
|
S NODE=$$ROOT^DILFD(798.3,,1),(CNT,RC)=0
|
|
S IEN=0
|
|
F S IEN=$O(@NODE@(IEN)) Q:IEN'>0 D
|
|
. W:SPI "."
|
|
. S:$D(@NODE@(IEN,1,"B",REGIEN)) CNT=CNT+1
|
|
Q $S(RC<0:RC,1:CNT)
|
|
;
|
|
;***** GATHERS THE INFORMATION ABOUT THE REGISTRY
|
|
;
|
|
; REGIEN Registry IEN
|
|
;
|
|
; ROR8DST Closed root of the destination array
|
|
;
|
|
; [FLAGS] Flags that control the execution (can be combined):
|
|
; E Count patients with errors in the
|
|
; ROR PATIENT EVENTS file
|
|
; P Include list of pending patients
|
|
; S Show the progress indicator
|
|
;
|
|
; @ROR8DST@(
|
|
; "DTACKMAX") The latest and the earliest dates by which
|
|
; "DTACKMIN") patient data transmissions are acknowledged
|
|
;
|
|
; "NPA") Number of active patients
|
|
; "NPE") Number of patients with errors in the
|
|
; ROR PATIENT EVENTS file
|
|
; "NPP") Number of pending patients
|
|
; "NPT") Total number of patients in the registry
|
|
; (including pending)
|
|
;
|
|
; "PPL",
|
|
; 0,1) Map of the corresponding data subnode
|
|
; (field names separated by ^)
|
|
; DFN) Pending patient
|
|
; ^01: IEN of the registry record
|
|
; ^02: Coded SSN
|
|
; DFN,1)
|
|
; Dates of the selection rules
|
|
; ^01: LAB
|
|
; ^02: PROBLEM
|
|
; ^03: PTF
|
|
; ^04: VISIT
|
|
;
|
|
; Return Values:
|
|
; <0 Error code
|
|
; 0 Ok
|
|
; >0 Number of ignored errors
|
|
;
|
|
REGINFO(REGIEN,ROR8DST,FLAGS) ;
|
|
N RORECNT ; Number of errors
|
|
N RORSRL ; List of selection rules
|
|
;
|
|
N COUNTS,CPPL,DTACKMIN,DTACKMAX,IEN,IENS,NODE,PTSTAT,RC,RORBUF,RORMSG,SPI,TMP
|
|
S FLAGS=$G(FLAGS),SPI=(FLAGS["S"),CPPL=(FLAGS["P")
|
|
S DTACKMIN=999999999,DTACKMAX=0
|
|
K @ROR8DST S (RC,RORECNT)=0
|
|
;
|
|
;--- Load the list of selection rules
|
|
I CPPL S RC=$$LOADSRL(REGIEN,.RORSRL) Q:RC<0 RC
|
|
;
|
|
;--- Examine registry records
|
|
W:SPI !,"Examining registry records",!
|
|
S NODE=$$ROOT^DILFD(798,,1)
|
|
S IEN=0
|
|
F S IEN=$O(@NODE@("AC",REGIEN,IEN)) Q:IEN'>0 D
|
|
. W:SPI "."
|
|
. S COUNTS("NPT")=$G(COUNTS("NPT"))+1 ; Total number of patients
|
|
. ;--- Load the data
|
|
. S IENS=IEN_"," K RORBUF
|
|
. D GETS^DIQ(798,IENS,".01;3;9.1","I","RORBUF","RORMSG")
|
|
. I $G(DIERR) D S RORECNT=RORECNT+1 Q
|
|
. . D DBS^RORERR("RORMSG",-9,,,798,IENS)
|
|
. S PTSTAT=+$G(RORBUF(798,IENS,3,"I"))
|
|
. ;--- Number of active patients
|
|
. D:$$ACTIVE^RORDD(IEN)
|
|
. . S COUNTS("NPA")=$G(COUNTS("NPA"))+1
|
|
. . S TMP=+$G(RORBUF(798,IENS,9.1,"I"))
|
|
. . I TMP>0 S:TMP<DTACKMIN DTACKMIN=TMP S:TMP>DTACKMAX DTACKMAX=TMP
|
|
. ;--- Add a pending patient to the list
|
|
. I PTSTAT=4 D:CPPL S COUNTS("NPP")=$G(COUNTS("NPP"))+1
|
|
. . S TMP=$$ADDPP(REGIEN,IEN,+RORBUF(798,IENS,.01,"I"))
|
|
;
|
|
;--- Count patients with errors
|
|
I FLAGS["E" D Q:RC<0 RC S @ROR8DST@("NPE")=RC
|
|
. S RC=$$PTERR(REGIEN,SPI)
|
|
;
|
|
;--- Success
|
|
I DTACKMAX>0 D
|
|
. S @ROR8DST@("DTACKMIN")=DTACKMIN
|
|
. S @ROR8DST@("DTACKMAX")=DTACKMAX
|
|
E F TMP="MIN","MAX" S @ROR8DST@("DTACK"_TMP)=""
|
|
I CPPL D:$G(COUNTS("NPP"))>0
|
|
. S RORBUF="",TMP=0
|
|
. F S TMP=$O(RORSRL(TMP)) Q:TMP'>0 D
|
|
. . S $P(RORBUF,U,+RORSRL(TMP))=$P(RORSRL(TMP),U,2)
|
|
. S @ROR8DST@("PPL",0,1)=RORBUF
|
|
F TMP="NPA","NPP","NPT" S @ROR8DST@(TMP)=+$G(COUNTS(TMP))
|
|
Q RORECNT
|
|
;
|
|
;***** E-MAILS THE INFORMATION ABOUT THE REGISTRY
|
|
;
|
|
; REGIEN Registry IEN
|
|
;
|
|
; [EMAIL] E-mail address where the data will be sent to
|
|
;
|
|
; [FLAGS] Flags that control the execution (can be combined):
|
|
; E Count patients with errors in the
|
|
; ROR PATIENT EVENTS file
|
|
; P Include list of pending patients
|
|
; S Show the progress indicator
|
|
;
|
|
; Return Values:
|
|
; <0 Error code
|
|
; 0 Ok
|
|
;
|
|
SENDINFO(REGIEN,EMAIL,FLAGS) ;
|
|
Q:'$$CCRNTFY^RORUTL05(REGIEN) 0
|
|
N DATE,IENS,INFO,MSGBUF,PARAMS,RC,RORBUF,RORMSG,TMP
|
|
S FLAGS=$G(FLAGS)
|
|
S INFO=$$ALLOC^RORTMP(),RC=0
|
|
S MSGBUF=$$ALLOC^RORTMP()
|
|
S PARAMS("DATE")=$$DATE($$DT^XLFDT)
|
|
;
|
|
;--- Gather the information
|
|
S RC=$$REGINFO(REGIEN,INFO,FLAGS)
|
|
;
|
|
D:RC'<0
|
|
. N I,MBI,NF,PATIEN,XMCHAN,XMDUZ,XMLOC,XMSUB,XMTEXT,XMY,XMZ
|
|
. S IENS=REGIEN_"," K @MSGBUF
|
|
. ;
|
|
. ;--- Load the registry parameters
|
|
. D GETS^DIQ(798.1,IENS,".01;1;2;13.3;19.3","I","RORBUF","RORMSG")
|
|
. I $G(DIERR) S RC=$$DBS^RORERR("RORMSG",-9,,,798.1,IENS) Q
|
|
. I $G(EMAIL)="" S EMAIL=$G(RORBUF(798.1,IENS,13.3,"I")) Q:EMAIL=""
|
|
. ;
|
|
. ;--- Header of the message body
|
|
. S TMP=$$SITE^RORUTL03()
|
|
. S PARAMS("STNAME")=$P(TMP,U,2)
|
|
. S PARAMS("STNUM")=$P(TMP,U)
|
|
. ;---
|
|
. F I="DTACKMAX","DTACKMIN" D
|
|
. . S PARAMS(I)=$$DATE(+$G(@INFO@(I)))
|
|
. F I="NPA","NPP","NPT" D
|
|
. . S PARAMS(I)=+$G(@INFO@(I))
|
|
. ;---
|
|
. S PARAMS("REGISTRY")=$G(RORBUF(798.1,IENS,.01,"I"))
|
|
. S PARAMS("RETRIES")=+$G(RORBUF(798.1,IENS,19.3,"I"))
|
|
. S PARAMS("UPDATED_UNTIL")=$$DATE($G(RORBUF(798.1,IENS,1,"I")))
|
|
. S PARAMS("EXTRACTED_UNTIL")=$$DATE($G(RORBUF(798.1,IENS,2,"I")))
|
|
. D BLD^DIALOG(7980000.021,.PARAMS,,MSGBUF,"S")
|
|
. S MBI=+$O(@MSGBUF@(""),-1)
|
|
. ;
|
|
. ;--- Number of patients with errors
|
|
. D:FLAGS["E"
|
|
. . S MBI=MBI+1,@MSGBUF@(MBI)="<NPE>"_$G(@INFO@("NPE"))_"</NPE>"
|
|
. ;
|
|
. ;--- List of pending patients
|
|
. D:FLAGS["P"
|
|
. . S RORBUF=$G(@INFO@("PPL",0,1))
|
|
. . F NF=1:1 Q:$P(RORBUF,U,NF)=""
|
|
. . S NF=NF-1
|
|
. . S MBI=MBI+1,@MSGBUF@(MBI)="<PPLIST>"
|
|
. . S MBI=MBI+1,@MSGBUF@(MBI)="CSSN,"_$TR(RORBUF,U,",")
|
|
. . S PATIEN=0
|
|
. . F S PATIEN=$O(@INFO@("PPL",PATIEN)) Q:PATIEN'>0 D
|
|
. . . S RORBUF=$G(@INFO@("PPL",PATIEN,1))
|
|
. . . F I=1:1:NF S $P(RORBUF,U,I)=$$DATE(+$P(RORBUF,U,I))
|
|
. . . S TMP=$P(@INFO@("PPL",PATIEN),U,2)
|
|
. . . S MBI=MBI+1,@MSGBUF@(MBI)=TMP_","_$TR(RORBUF,U,",")
|
|
. . S MBI=MBI+1,@MSGBUF@(MBI)="</PPLIST>"
|
|
. ;
|
|
. ;--- Footer of the message body
|
|
. D BLD^DIALOG(7980000.022,.PARAMS,,MSGBUF,"S")
|
|
. ;
|
|
. ;--- Send the message
|
|
. S XMDUZ=.5,XMY(EMAIL)=""
|
|
. S XMSUB="ROR: REGISTRY INFO"
|
|
. S XMTEXT=$$OREF^DILF(MSGBUF)
|
|
. D ^XMD
|
|
;
|
|
;--- Cleanup
|
|
D FREE^RORTMP(INFO),FREE^RORTMP(MSGBUF)
|
|
Q $S(RC<0:RC,1:0)
|