- 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 Feb 18, 2025@23:10:31 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)