Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: RORUTL17

RORUTL17.m

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