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

RORREP01.m

Go to the documentation of this file. 
  1. RORREP01 ;HOIFO/BH - REGISTRY COMPARISON REPORT ; 12/21/05 11:55am
  1.  ;;1.5;CLINICAL CASE REGISTRIES;;Feb 17, 2006
  1.  ;
  1.  ;--------------------------------------------------------------------
  1.  ; Registry: [VA HIV]
  1.  ;--------------------------------------------------------------------
  1.  ;
  1.  Q
  1.  ;
  1. BEGIN ;
  1.  I '$$VFILE^DILFD(158)  D  Q
  1.  . W !,"ICR v2.1 is not installed in this account!",!
  1.  I '$D(^XUSEC("IMRA",DUZ)) S IMRLOC="RORREP01" D ACESSERR^IMRERR,H^XUS K IMRLOC
  1.  ;
  1.  W !,?10,"####################################################"
  1.  W !,?10,"#",?20,"Local ICR Version Comparison Report      #",?61
  1.  W !,?10,"####################################################"
  1.  ;
  1.  ;
  1. DEV D IMRDEV^IMREDIT
  1.  G:POP KILL
  1.  I '$D(IO("Q")) W @IOF D REP Q
  1.  I $D(IO("Q")) D  G KILL
  1.  . S ZTRTN="REP^RORREP01",ZTDESC="Local ICR Version Comparison Report"
  1.  . S ZTSAVE("*")="",ZTIO=ION_";"_IOM_";"_IOSL
  1.  . D ^%ZTLOAD K ZTRTN,ZTDESC,ZTSAVE,ZTSK
  1.  . Q
  1.  ;
  1. REP ; Get Data
  1.  U IO
  1.  D EN1
  1.  K CNT
  1.  ;
  1.  D PRNT^RORREP02
  1. CLOSE D ^%ZISC K %ZIS,IOP
  1.  S:$D(ZTQUEUED) ZTREQ="@"
  1.  ;
  1.  ;
  1. KILL D ^%ZISC
  1.  K ^TMP("RORREP01",$J)
  1.  K DTOUT,VAROOT,VAERR,A,DIRUT,I,J,POP,X,X0,X1,Y,Z,D,IMRDTE,IMRFLG,IMRHED,IMRRPG,%I,DISYS,IMRPG
  1.  D HOME^%ZIS
  1.  Q
  1.  ;
  1.  ; ---------------------------------------------------------------------
  1. EN1 ;
  1.  K ^TMP("RORREP01",$J)
  1.  S CNT=0
  1.  D VTHREE
  1.  D VTWO
  1.  ;
  1.  D INTWO
  1.  D INTHREE
  1.  Q
  1.  ;
  1. VTHREE ; Make array of version 3 patients 
  1.  N ICN,IDSC,NAME,RC,PAT
  1.  K VTHREE
  1.  S RC=$$PATITER^RORAPI01(.IDSC,"VA HIV")
  1.  I RC<0 Q
  1.  F  S RC=$$NEXTPAT^RORAPI01(.IDSC)  Q:RC'>0  D
  1.  . S PAT=+RC
  1.  . S ^TMP("RORREP01",$J,"VTHREE",PAT)=""
  1.  . S ICN=$$GETICN^MPIF001(PAT)
  1.  . Q:$L(ICN)'=9
  1.  . S NAME=$P(^DPT(PAT,0),"^",1)
  1.  . S ^TMP("RORREP01",$J,"ICN",NAME,PAT)=""
  1.  Q
  1.  ;
  1.  ;
  1. VTWO ; Make array of version 2.1 patients
  1.  N ENCODE,PAT,IMRIEN
  1.  S IMRIEN=0
  1.  F  S IMRIEN=$O(^IMR(158,IMRIEN)) Q:'IMRIEN  D
  1.  . S ENCODE=$P(^IMR(158,IMRIEN,0),U)
  1.  . I ENCODE="" D  Q
  1.  . . S CNT=CNT+1
  1.  . . S ^TMP("RORREP01",$J,"ERROR","ENCODE",CNT)="Entry "_IMRIEN_" in file #158 does not have .01 field." Q
  1.  . S PAT=$$XOR^RORUTL03(ENCODE)
  1.  . I PAT=0!(PAT="") D  Q
  1.  . . S CNT=CNT+1
  1.  . . S ^TMP("RORREP01",$J,"ERROR","ENCODE",CNT)="Could not decode .01 field "_ENCODE_" of file #158."
  1.  . ;
  1.  . I $D(^DPT(PAT,-9)) D  Q
  1.  . . N NEWIEN
  1.  . . S NEWIEN=^DPT(PAT,-9)
  1.  . . I NEWIEN="" Q
  1.  . . I $D(^TMP("RORREP01",$J,"PROC",NEWIEN)) Q
  1.  . . S ^TMP("RORREP01",$J,"MERGE",NEWIEN)=ENCODE
  1.  . ;
  1.  . I $$GET1^DIQ(2,PAT,.01)="" D  Q
  1.  . . S CNT=CNT+1
  1.  . . S ^TMP("RORREP01",$J,"ERROR","ENCODE",CNT)="Could not get patient name from patient file IEN "_PAT Q
  1.  . ;
  1.  . D VTWO1(PAT,ENCODE)
  1.  ;
  1.  I $D(^TMP("RORREP01",$J,"MERGE")) D
  1.  . N ENC,SUB4 S SUB4=0
  1.  . F  S SUB4=$O(^TMP("RORREP01",$J,"MERGE",SUB4)) Q:SUB4=""  D
  1.  . . S ENC=^TMP("RORREP01",$J,"MERGE",SUB4)
  1.  . . D VTWO1(SUB4,ENC)
  1.  ;
  1.  K ^TMP("RORREP01",$J,"PROC"),^TMP("RORREP01",$J,"MERGE")
  1.  Q
  1.  ;
  1. VTWO1(PAT,ENCODE) ;
  1.  N ICN,SSN
  1.  I $$GET1^DIQ(2,PAT,.01)="" D  Q
  1.  . S CNT=CNT+1
  1.  . S ^TMP("RORREP01",$J,"ERROR","ENCODE",CNT)="Could not get file #2 entry for entry "_ENCODE_" of file #158."
  1.  ;
  1.  S ^TMP("RORREP01",$J,"PROC",PAT)=""
  1.  S ^TMP("RORREP01",$J,"VTWO",PAT)=ENCODE
  1.  I PAT=7202138 W ENCODE_"***"
  1.  S ICN=$$GETICN^MPIF001(PAT)
  1.  Q:$L(ICN)'=9
  1.  S NAME=$P(^DPT(PAT,0),"^",1)
  1.  S SSN=$$GET1^DIQ(2,PAT,.09),SSN=$E(SSN,6,9)
  1.  S ^TMP("RORREP01",$J,"ICN",NAME,PAT)=SSN
  1.  Q
  1.  ;
  1. INTWO ; Patients in version 2.1 and not in three or in both
  1.  N IEN,NAME,DATE21,RULE,SSN S IEN=0
  1.  F  S IEN=$O(^TMP("RORREP01",$J,"VTWO",IEN)) Q:IEN=""  D
  1.  . S NAME=$$GET1^DIQ(2,IEN,.01)
  1.  . S SSN=$$GET1^DIQ(2,IEN,.09),SSN=$E(SSN,6,9)
  1.  . S DATE21=$$DATE21(^TMP("RORREP01",$J,"VTWO",IEN))
  1.  . I '$D(^TMP("RORREP01",$J,"VTHREE",IEN)) D  Q
  1.  . . S ^TMP("RORREP01",$J,"INTWO",NAME)=DATE21_"^"_SSN
  1.  . S RULE=$$RULE(IEN) I RULE=0 Q
  1.  . S ^TMP("RORREP01",$J,"INBOTH",NAME)=RULE_"^"_DATE21_"^"_SSN
  1.  Q
  1.  ;
  1.  ;
  1. INTHREE ; Patients in version 3.0 and not in two OR in both
  1.  N DATE21,RULE,IEN,PENDING,NAME,SSN S IEN=0
  1.  F  S IEN=$O(^TMP("RORREP01",$J,"VTHREE",IEN)) Q:IEN=""  D
  1.  . S NAME=$$GET1^DIQ(2,IEN,.01)
  1.  . S SSN=$$GET1^DIQ(2,IEN,.09),SSN=$E(SSN,6,9)
  1.  . I NAME="" S CNT=CNT+1,^TMP("RORREP01",$J,"ERROR","ROR",CNT)="Can't find Name from patient (#2) file IEN "_IEN_"." Q
  1.  . ;
  1.  . S RULE=$$RULE(IEN) I RULE=0 Q
  1.  . I '$D(^TMP("RORREP01",$J,"VTWO",IEN)) D  Q
  1.  . . S PENDING=$$PEND(IEN)
  1.  . . S ^TMP("RORREP01",$J,"INTHREE",NAME)=RULE_"^"_PENDING_"^"_SSN
  1.  . S DATE21=$$DATE21(^TMP("RORREP01",$J,"VTWO",IEN))
  1.  . S ^TMP("RORREP01",$J,"INBOTH",NAME)=RULE_"^"_DATE21_"^"_SSN
  1.  Q
  1.  ;
  1.  ;
  1. DATE21(ENCODE) ; Get date added to ICR 2.1
  1.  N IMRCAT1,IMRCAT2,IMRCAT3,IMRCAT4,IMRNODE,IMRIEN,IMRDTE,IMRARR
  1.  S IMRIEN=0
  1.  S IMRIEN=$O(^IMR(158,"B",ENCODE,IMRIEN))
  1.  S IMRNODE=^IMR(158,IMRIEN,0)
  1.  S IMRCAT1=$P(IMRNODE,"^",36) I IMRCAT1'="" S IMRARR(IMRCAT1)=""
  1.  S IMRCAT2=$P(IMRNODE,"^",44) I IMRCAT2'="" S IMRARR(IMRCAT2)=""
  1.  S IMRCAT3=$P(IMRNODE,"^",35) I IMRCAT3'="" S IMRARR(IMRCAT3)=""
  1.  S IMRCAT4=$P(IMRNODE,"^",23) I IMRCAT4'="" S IMRARR(IMRCAT4)=""
  1.  I '$D(IMRARR) Q "No Cat. Date"
  1.  S IMRDTE=""
  1.  S IMRDTE=$O(IMRARR(IMRDTE))
  1.  S Y=IMRDTE D DD^%DT S IMRDTE=Y
  1.  Q IMRDTE
  1.  ;
  1.  ;
  1. PEND(IEN) ;
  1.  N RORIEN,PEND
  1.  S RORIEN="",PEND="YES"
  1.  S RORIEN=$O(^RORDATA(798,"KEY",IEN,2,RORIEN))
  1.  S RES=$P(^RORDATA(798,RORIEN,0),"^",5)
  1.  I RES'=4 S PEND="NO"
  1.  Q PEND
  1.  ;
  1.  ;
  1. RULE(IEN) ; Get earliest selction rule 
  1.  N RORIEN
  1.  S RORIEN=""
  1.  S RORIEN=$O(^RORDATA(798,"KEY",IEN,2,RORIEN))
  1.  I 'RORIEN D  Q 0
  1.  . S CNT=CNT+1
  1.  . S ^TMP("RORREP01",$J,"ERROR","ROR",CNT)="Can't find IEN of file #798 record that has a #.01 field of "_IEN_"." Q
  1.  ;
  1.  N RULE1,DATE1,SELARR,RORSRIEN,SELDATE,DATA,RULE
  1.  S RORSRIEN=0
  1.  F  S RORSRIEN=$O(^RORDATA(798,RORIEN,1,RORSRIEN)) Q:'RORSRIEN  D
  1.  . S DATA=^RORDATA(798,RORIEN,1,RORSRIEN,0)
  1.  . S RULE=$P(DATA,"^",1)
  1.  . S RULE=$$GET1^DIQ(798.2,RULE,.01,"E")
  1.  . S SELDATE=$P(DATA,"^",2)
  1.  . S SELARR(SELDATE)=RULE
  1.  ;
  1.  I '$D(SELARR) D  Q 0
  1.  . S CNT=CNT+1
  1.  . N BUFF,EVID,NME
  1.  . S NME=$$GET1^DIQ(798,RORIEN,.01,"E")
  1.  . ;
  1.  . S EVID=$P(^RORDATA(798,RORIEN,0),U,14)
  1.  . I 'EVID D
  1.  . . S BUFF=NME_" is in ROR Local Registry file (#798) but has no selection rules."
  1.  . . S ^TMP("RORREP01",$J,"ERROR",IEN)=BUFF
  1.  . I EVID D
  1.  . . S ^TMP("RORREP01",$J,"ISSUE","EVID",IEN)=NME
  1.  S DATE1="" S DATE1=$O(SELARR(DATE1))
  1.  S RULE1=SELARR(DATE1)
  1.  S Y=DATE1 D DD^%DT S DATE1=Y
  1.  Q DATE1_"^"_RULE1
  1.  ;
  1.  ;