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)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRORUTL17 8223 printed Dec 13, 2024@01:44:08 Page 2
RORUTL17 ;HCIOFO/SG - REGISTRY INFORMATION UTILITIES ; 8/25/05 1:44pm
+1 ;;1.5;CLINICAL CASE REGISTRIES;;Feb 17, 2006
+2 ;
+3 QUIT
+4 ;
+5 ;***** ADDS THE PENDING PATIENT TO THE LIST
+6 ;
+7 ; REGIEN Registry IEN
+8 ; IEN IEN of the registry record
+9 ; PATIEN Patient IEN (DFN)
+10 ;
+11 ; Return Values:
+12 ; <0 Error code
+13 ; 0 Ok
+14 ;
ADDPP(REGIEN,IEN,PATIEN) ;
+1 NEW BUF,I,NODE,IEN1,TMP,VA,VADM
+2 DO VADEM^RORUTL05(PATIEN)
+3 SET @ROR8DST@("PPL",PATIEN)=IEN_U_$$XOR^RORUTL03($PIECE($GET(VADM(2)),U))
+4 ;--- Dates of selection rules
+5 SET NODE=$$ROOT^DILFD(798.01,","_IEN_",",1)
SET BUF=""
+6 SET IEN1=0
+7 FOR
SET IEN1=$ORDER(@NODE@(IEN1))
if IEN1'>0
QUIT
Begin DoDot:1
+8 SET TMP=$GET(@NODE@(IEN1,0))
SET I=+$GET(RORSRL(+TMP))
+9 if I>0
SET $PIECE(BUF,U,I)=$PIECE(TMP,U,2)
End DoDot:1
+10 SET @ROR8DST@("PPL",PATIEN,1)=BUF
+11 QUIT 0
+12 ;
+13 ;***** FORMATS THE DATE
DATE(DATE) ;
+1 QUIT $SELECT(DATE>1:$$FMTE^XLFDT(DATE\1,"5Z"),1:"")
+2 ;
+3 ;***** LOADS THE LIST OF SELECTION RULES
+4 ;
+5 ; REGIEN Registry IEN
+6 ; .SRLST Reference to a local variable for the
+7 ; list of selection rules
+8 ;
+9 ; Return Values:
+10 ; <0 Error code
+11 ; 0 Ok
+12 ;
LOADSRL(REGIEN,SRLST) ;
+1 NEW IEN,NAME,NODE
+2 SET NODE=$$ROOT^DILFD(798.2,,1)
+3 SET IEN=0
+4 FOR
SET IEN=$ORDER(@NODE@(IEN))
if IEN'>0
QUIT
Begin DoDot:1
+5 SET NAME=$PIECE($GET(@NODE@(IEN,0)),U)
if NAME=""
QUIT
+6 IF NAME?1"VA"1.E1"LAB".E
SET SRLST(IEN)="1^LAB"
QUIT
+7 IF NAME?1"VA"1.E1"PROBLEM".E
SET SRLST(IEN)="2^PROBLEM"
QUIT
+8 IF NAME?1"VA"1.E1"PTF".E
SET SRLST(IEN)="3^PTF"
QUIT
+9 IF NAME?1"VA"1.E1"VPOV".E
SET SRLST(IEN)="4^VISIT"
QUIT
+10 IF NAME?1"VA"1.E1"VISIT".E
SET SRLST(IEN)="4^VISIT"
QUIT
End DoDot:1
+11 QUIT 0
+12 ;
+13 ;***** COUNTS PATIENTS WITH ERRORS
+14 ;
+15 ; REGIEN Registry IEN
+16 ;
+17 ; Return Values:
+18 ; <0 Error code
+19 ; 0 Ok
+20 ; >0 Number of patients with errors
+21 ;
PTERR(REGIEN,SPI) ;
+1 NEW CNT,IEN,NODE,RC,TMP
+2 if SPI
WRITE !,"Counting patients with errors",!
+3 SET NODE=$$ROOT^DILFD(798.3,,1)
SET (CNT,RC)=0
+4 SET IEN=0
+5 FOR
SET IEN=$ORDER(@NODE@(IEN))
if IEN'>0
QUIT
Begin DoDot:1
+6 if SPI
WRITE "."
+7 if $DATA(@NODE@(IEN,1,"B",REGIEN))
SET CNT=CNT+1
End DoDot:1
+8 QUIT $SELECT(RC<0:RC,1:CNT)
+9 ;
+10 ;***** GATHERS THE INFORMATION ABOUT THE REGISTRY
+11 ;
+12 ; REGIEN Registry IEN
+13 ;
+14 ; ROR8DST Closed root of the destination array
+15 ;
+16 ; [FLAGS] Flags that control the execution (can be combined):
+17 ; E Count patients with errors in the
+18 ; ROR PATIENT EVENTS file
+19 ; P Include list of pending patients
+20 ; S Show the progress indicator
+21 ;
+22 ; @ROR8DST@(
+23 ; "DTACKMAX") The latest and the earliest dates by which
+24 ; "DTACKMIN") patient data transmissions are acknowledged
+25 ;
+26 ; "NPA") Number of active patients
+27 ; "NPE") Number of patients with errors in the
+28 ; ROR PATIENT EVENTS file
+29 ; "NPP") Number of pending patients
+30 ; "NPT") Total number of patients in the registry
+31 ; (including pending)
+32 ;
+33 ; "PPL",
+34 ; 0,1) Map of the corresponding data subnode
+35 ; (field names separated by ^)
+36 ; DFN) Pending patient
+37 ; ^01: IEN of the registry record
+38 ; ^02: Coded SSN
+39 ; DFN,1)
+40 ; Dates of the selection rules
+41 ; ^01: LAB
+42 ; ^02: PROBLEM
+43 ; ^03: PTF
+44 ; ^04: VISIT
+45 ;
+46 ; Return Values:
+47 ; <0 Error code
+48 ; 0 Ok
+49 ; >0 Number of ignored errors
+50 ;
REGINFO(REGIEN,ROR8DST,FLAGS) ;
+1 ; Number of errors
NEW RORECNT
+2 ; List of selection rules
NEW RORSRL
+3 ;
+4 NEW COUNTS,CPPL,DTACKMIN,DTACKMAX,IEN,IENS,NODE,PTSTAT,RC,RORBUF,RORMSG,SPI,TMP
+5 SET FLAGS=$GET(FLAGS)
SET SPI=(FLAGS["S")
SET CPPL=(FLAGS["P")
+6 SET DTACKMIN=999999999
SET DTACKMAX=0
+7 KILL @ROR8DST
SET (RC,RORECNT)=0
+8 ;
+9 ;--- Load the list of selection rules
+10 IF CPPL
SET RC=$$LOADSRL(REGIEN,.RORSRL)
if RC<0
QUIT RC
+11 ;
+12 ;--- Examine registry records
+13 if SPI
WRITE !,"Examining registry records",!
+14 SET NODE=$$ROOT^DILFD(798,,1)
+15 SET IEN=0
+16 FOR
SET IEN=$ORDER(@NODE@("AC",REGIEN,IEN))
if IEN'>0
QUIT
Begin DoDot:1
+17 if SPI
WRITE "."
+18 ; Total number of patients
SET COUNTS("NPT")=$GET(COUNTS("NPT"))+1
+19 ;--- Load the data
+20 SET IENS=IEN_","
KILL RORBUF
+21 DO GETS^DIQ(798,IENS,".01;3;9.1","I","RORBUF","RORMSG")
+22 IF $GET(DIERR)
Begin DoDot:2
+23 DO DBS^RORERR("RORMSG",-9,,,798,IENS)
End DoDot:2
SET RORECNT=RORECNT+1
QUIT
+24 SET PTSTAT=+$GET(RORBUF(798,IENS,3,"I"))
+25 ;--- Number of active patients
+26 if $$ACTIVE^RORDD(IEN)
Begin DoDot:2
+27 SET COUNTS("NPA")=$GET(COUNTS("NPA"))+1
+28 SET TMP=+$GET(RORBUF(798,IENS,9.1,"I"))
+29 IF TMP>0
if TMP<DTACKMIN
SET DTACKMIN=TMP
if TMP>DTACKMAX
SET DTACKMAX=TMP
End DoDot:2
+30 ;--- Add a pending patient to the list
+31 IF PTSTAT=4
if CPPL
Begin DoDot:2
+32 SET TMP=$$ADDPP(REGIEN,IEN,+RORBUF(798,IENS,.01,"I"))
End DoDot:2
SET COUNTS("NPP")=$GET(COUNTS("NPP"))+1
End DoDot:1
+33 ;
+34 ;--- Count patients with errors
+35 IF FLAGS["E"
Begin DoDot:1
+36 SET RC=$$PTERR(REGIEN,SPI)
End DoDot:1
if RC<0
QUIT RC
SET @ROR8DST@("NPE")=RC
+37 ;
+38 ;--- Success
+39 IF DTACKMAX>0
Begin DoDot:1
+40 SET @ROR8DST@("DTACKMIN")=DTACKMIN
+41 SET @ROR8DST@("DTACKMAX")=DTACKMAX
End DoDot:1
+42 IF '$TEST
FOR TMP="MIN","MAX"
SET @ROR8DST@("DTACK"_TMP)=""
+43 IF CPPL
if $GET(COUNTS("NPP"))>0
Begin DoDot:1
+44 SET RORBUF=""
SET TMP=0
+45 FOR
SET TMP=$ORDER(RORSRL(TMP))
if TMP'>0
QUIT
Begin DoDot:2
+46 SET $PIECE(RORBUF,U,+RORSRL(TMP))=$PIECE(RORSRL(TMP),U,2)
End DoDot:2
+47 SET @ROR8DST@("PPL",0,1)=RORBUF
End DoDot:1
+48 FOR TMP="NPA","NPP","NPT"
SET @ROR8DST@(TMP)=+$GET(COUNTS(TMP))
+49 QUIT RORECNT
+50 ;
+51 ;***** E-MAILS THE INFORMATION ABOUT THE REGISTRY
+52 ;
+53 ; REGIEN Registry IEN
+54 ;
+55 ; [EMAIL] E-mail address where the data will be sent to
+56 ;
+57 ; [FLAGS] Flags that control the execution (can be combined):
+58 ; E Count patients with errors in the
+59 ; ROR PATIENT EVENTS file
+60 ; P Include list of pending patients
+61 ; S Show the progress indicator
+62 ;
+63 ; Return Values:
+64 ; <0 Error code
+65 ; 0 Ok
+66 ;
SENDINFO(REGIEN,EMAIL,FLAGS) ;
+1 if '$$CCRNTFY^RORUTL05(REGIEN)
QUIT 0
+2 NEW DATE,IENS,INFO,MSGBUF,PARAMS,RC,RORBUF,RORMSG,TMP
+3 SET FLAGS=$GET(FLAGS)
+4 SET INFO=$$ALLOC^RORTMP()
SET RC=0
+5 SET MSGBUF=$$ALLOC^RORTMP()
+6 SET PARAMS("DATE")=$$DATE($$DT^XLFDT)
+7 ;
+8 ;--- Gather the information
+9 SET RC=$$REGINFO(REGIEN,INFO,FLAGS)
+10 ;
+11 if RC'<0
Begin DoDot:1
+12 NEW I,MBI,NF,PATIEN,XMCHAN,XMDUZ,XMLOC,XMSUB,XMTEXT,XMY,XMZ
+13 SET IENS=REGIEN_","
KILL @MSGBUF
+14 ;
+15 ;--- Load the registry parameters
+16 DO GETS^DIQ(798.1,IENS,".01;1;2;13.3;19.3","I","RORBUF","RORMSG")
+17 IF $GET(DIERR)
SET RC=$$DBS^RORERR("RORMSG",-9,,,798.1,IENS)
QUIT
+18 IF $GET(EMAIL)=""
SET EMAIL=$GET(RORBUF(798.1,IENS,13.3,"I"))
if EMAIL=""
QUIT
+19 ;
+20 ;--- Header of the message body
+21 SET TMP=$$SITE^RORUTL03()
+22 SET PARAMS("STNAME")=$PIECE(TMP,U,2)
+23 SET PARAMS("STNUM")=$PIECE(TMP,U)
+24 ;---
+25 FOR I="DTACKMAX","DTACKMIN"
Begin DoDot:2
+26 SET PARAMS(I)=$$DATE(+$GET(@INFO@(I)))
End DoDot:2
+27 FOR I="NPA","NPP","NPT"
Begin DoDot:2
+28 SET PARAMS(I)=+$GET(@INFO@(I))
End DoDot:2
+29 ;---
+30 SET PARAMS("REGISTRY")=$GET(RORBUF(798.1,IENS,.01,"I"))
+31 SET PARAMS("RETRIES")=+$GET(RORBUF(798.1,IENS,19.3,"I"))
+32 SET PARAMS("UPDATED_UNTIL")=$$DATE($GET(RORBUF(798.1,IENS,1,"I")))
+33 SET PARAMS("EXTRACTED_UNTIL")=$$DATE($GET(RORBUF(798.1,IENS,2,"I")))
+34 DO BLD^DIALOG(7980000.021,.PARAMS,,MSGBUF,"S")
+35 SET MBI=+$ORDER(@MSGBUF@(""),-1)
+36 ;
+37 ;--- Number of patients with errors
+38 if FLAGS["E"
Begin DoDot:2
+39 SET MBI=MBI+1
SET @MSGBUF@(MBI)="<NPE>"_$GET(@INFO@("NPE"))_"</NPE>"
End DoDot:2
+40 ;
+41 ;--- List of pending patients
+42 if FLAGS["P"
Begin DoDot:2
+43 SET RORBUF=$GET(@INFO@("PPL",0,1))
+44 FOR NF=1:1
if $PIECE(RORBUF,U,NF)=""
QUIT
+45 SET NF=NF-1
+46 SET MBI=MBI+1
SET @MSGBUF@(MBI)="<PPLIST>"
+47 SET MBI=MBI+1
SET @MSGBUF@(MBI)="CSSN,"_$TRANSLATE(RORBUF,U,",")
+48 SET PATIEN=0
+49 FOR
SET PATIEN=$ORDER(@INFO@("PPL",PATIEN))
if PATIEN'>0
QUIT
Begin DoDot:3
+50 SET RORBUF=$GET(@INFO@("PPL",PATIEN,1))
+51 FOR I=1:1:NF
SET $PIECE(RORBUF,U,I)=$$DATE(+$PIECE(RORBUF,U,I))
+52 SET TMP=$PIECE(@INFO@("PPL",PATIEN),U,2)
+53 SET MBI=MBI+1
SET @MSGBUF@(MBI)=TMP_","_$TRANSLATE(RORBUF,U,",")
End DoDot:3
+54 SET MBI=MBI+1
SET @MSGBUF@(MBI)="</PPLIST>"
End DoDot:2
+55 ;
+56 ;--- Footer of the message body
+57 DO BLD^DIALOG(7980000.022,.PARAMS,,MSGBUF,"S")
+58 ;
+59 ;--- Send the message
+60 SET XMDUZ=.5
SET XMY(EMAIL)=""
+61 SET XMSUB="ROR: REGISTRY INFO"
+62 SET XMTEXT=$$OREF^DILF(MSGBUF)
+63 DO ^XMD
End DoDot:1
+64 ;
+65 ;--- Cleanup
+66 DO FREE^RORTMP(INFO)
DO FREE^RORTMP(MSGBUF)
+67 QUIT $SELECT(RC<0:RC,1:0)
