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

BQICAUTL.m

Go to the documentation of this file.
  1. BQICAUTL ;VNGT/HS/ALA-Utility for CA ; 29 Mar 2011 4:49 PM
  1. ;;2.6;ICARE MANAGEMENT SYSTEM;;Jul 07, 2017;Build 72
  1. ;
  1. TAX(TMFRAME,TAX,NIT,PTDFN,FREF,PRB,SAME,TREF) ;EP
  1. ; Find value for a taxonomy (TAX) or list of taxonomies (TREF)
  1. ; Input
  1. ; TMFRAME - Timeframe to search for data
  1. ; TAX - Taxonomy
  1. ; NIT - Number of iterations
  1. ; PTDFN - Patient IEN
  1. ; FREF - File number reference
  1. ; PRB - If Active Problem okay
  1. ; SAME - If NIT is allowed for the same 30 days or not (1 same 30 days okay)
  1. ; TREF - Multiple same resulting taxonomies (e.g. MEDs) built
  1. ; into reference (usually global)
  1. ;
  1. NEW RESULT,GREF,ENDT,IEN,TIEN,TEMP,QFL
  1. S TMFRAME=$G(TMFRAME,""),NIT=$G(NIT,1),PRB=$G(PRB,0),SAME=$G(SAME,1)
  1. S ENDT=$$DATE^BQIUL1(TMFRAME),RESULT=0,TREF=$G(TREF,""),TAX=$G(TAX,"")
  1. I TAX'="" D
  1. . S TREF=$NA(^TMP("BQITAX",UID))
  1. . K @TREF
  1. . D BLD^BQITUTL(TAX,TREF)
  1. S GREF=$$ROOT^DILFD(FREF,"",1)
  1. S TEMP=$NA(^TMP("BQITEMP",UID)) K @TEMP
  1. ;
  1. I PRB D
  1. . S IEN="",QFL=0,RESULT=0
  1. . F S IEN=$O(^AUPNPROB("AC",PTDFN,IEN),-1) Q:IEN="" D Q:QFL
  1. .. S TIEN=$$GET1^DIQ(9000011,IEN,.01,"I") I TIEN="" Q
  1. .. I '$D(@TREF@(TIEN)) Q
  1. .. ; Check class - if Family ignore
  1. .. I $$GET1^DIQ(9000011,IEN,.04,"I")="F" Q
  1. .. I $$GET1^DIQ(9000011,IEN,.12,"I")'="A" Q
  1. .. S VSDTM=$$PROB^BQIUL1(IEN)\1 Q:VSDTM=0
  1. .. I $G(TMFRAME)'="",VSDTM<ENDT Q
  1. .. S RESULT=1_U_VSDTM,$P(RESULT,U,4)=IEN,QFL=1
  1. ;
  1. I 'RESULT D
  1. . S IEN="",QFL=0,RESULT=0,CT=0
  1. . I $G(TMFRAME)'="" D
  1. .. S EDT=9999999-ENDT,BDT=""
  1. .. F S BDT=$O(@GREF@("AA",PTDFN,BDT)) Q:BDT=""!(BDT>EDT) D
  1. ... S IEN=""
  1. ... F S IEN=$O(@GREF@("AA",PTDFN,BDT,IEN)) Q:IEN="" D
  1. .... S TIEN=$$GET1^DIQ(FREF,IEN,.01,"I") I TIEN="" Q
  1. .... I '$D(@TREF@(TIEN)) Q
  1. .... S VISIT=$$GET1^DIQ(FREF,IEN,.03,"I") I VISIT="" Q
  1. .... I $$GET1^DIQ(9000010,VISIT,.11,"I")=1 Q
  1. .... S VSDTM=$$GET1^DIQ(9000010,VISIT,.01,"I")\1 Q:VSDTM=0
  1. .... ;I $G(TMFRAME)'="",VSDTM<ENDT Q
  1. .... ; Set temporary
  1. .... S @TEMP@(VSDTM,VISIT,IEN)=""
  1. . ;
  1. . I $G(TMFRAME)="" D
  1. .. F S IEN=$O(@GREF@("AC",PTDFN,IEN),-1) Q:IEN="" D
  1. ... S TIEN=$$GET1^DIQ(FREF,IEN,.01,"I") I TIEN="" Q
  1. ... I '$D(@TREF@(TIEN)) Q
  1. ... S VISIT=$$GET1^DIQ(FREF,IEN,.03,"I") I VISIT="" Q
  1. ... I $$GET1^DIQ(9000010,VISIT,.11,"I")=1 Q
  1. ... S VSDTM=$$GET1^DIQ(9000010,VISIT,.01,"I")\1 Q:VSDTM=0
  1. ... ;I $G(TMFRAME)'="",VSDTM<ENDT Q
  1. ... ; Set temporary
  1. ... S @TEMP@(VSDTM,VISIT,IEN)=""
  1. ;
  1. S VSDTM="",QFL=0
  1. F S VSDTM=$O(@TEMP@(VSDTM),-1) Q:VSDTM=""!(QFL) D
  1. . S VISIT=""
  1. . F S VISIT=$O(@TEMP@(VSDTM,VISIT),-1) Q:VISIT="" D Q:QFL
  1. .. S IEN=""
  1. .. F S IEN=$O(@TEMP@(VSDTM,VISIT,IEN),-1) Q:IEN="" D Q:QFL
  1. ... ; If result cannot be within 30 days, quit
  1. ... I 'SAME,$P(RESULT,U,2)=VSDTM Q
  1. ... S CT=CT+1
  1. ... I $P(RESULT,U,2)'="",(CT'>NIT) D
  1. .... I VSDTM'<STDT,'SAME S CT=CT-1 Q
  1. .... S $P(RESULT,U,2)=$P(RESULT,U,2)_";"_VSDTM
  1. .... S $P(RESULT,U,4)=$P(RESULT,U,4)_";"_VISIT
  1. .... S $P(RESULT,U,5)=$P(RESULT,U,5)_";"_IEN
  1. ... I $P(RESULT,U,2)="" S $P(RESULT,U,2)=VSDTM,$P(RESULT,U,4)=VISIT_U_IEN
  1. ... ;S $P(RESULT,U,4)=VISIT_U_IEN,CT=CT+1
  1. ... ;S RESULT=U_VSDTM_U_U_VISIT_U_IEN,CT=CT+1
  1. ... I CT=NIT S QFL=1,$P(RESULT,U,1)=1
  1. K @TREF
  1. Q RESULT
  1. ;
  1. MEAS(BQDFN,MEAS,VISIT,RESVAL,OPER) ;EP - Get measurement
  1. I MEAS'?.N S MEAS=$$FIND1^DIC(9999999.07,,"MX",MEAS)
  1. S VALUE=0
  1. S VDATE=$P(^AUPNVSIT(VISIT,0),U,1)\1
  1. S RVDT=9999999-VDATE
  1. S IEN=""
  1. F S IEN=$O(^AUPNVMSR("AA",BQDFN,MEAS,RVDT,IEN)) Q:IEN="" D
  1. . S RESULT=$P($G(^AUPNVMSR(IEN,0)),"^",4) I RESULT="" Q
  1. . I $P($G(^AUPNVMSR(IEN,2)),"^",1)=1 Q
  1. . ; if the new ENTERED IN ERROR field exists, exclude the record if it is marked as an error
  1. . I $$VFIELD^DILFD(9000010.01,2) Q:$$GET1^DIQ(9000010.01,IEN_",",2,"I")=1
  1. . I @(RESULT_OPER_RESVAL) S VALUE="1^"_VDATE_U_RESULT_U_VISIT_U_IEN_U_"9000010.01"
  1. Q VALUE
  1. ;
  1. LAB(TMFRAME,RECENT,BQDFN,TAX,SEARCH,TREF) ;EP
  1. ; Check for a lab test result
  1. ;
  1. ; Input
  1. ; TMFRAME - Time frame to search data for
  1. ; RECENT - 1=Only check most recent lab,0=Check all within timeframe
  1. ; BQDFN - Patient internal entry number
  1. ; TAX - Lab taxonomy to search
  1. ; RESULT - Lab result to check for
  1. ; OPER - Operand to use for result check
  1. ; RES2 - If range, the other result value
  1. ; OPER2 - If range, the other result operand
  1. ; TREF - Multiple same resulting taxonomies built
  1. ; into reference (usually global)
  1. ;
  1. NEW TEMP,EDATE,BDATE,LIEN,QFL,RES,CT,VALUE,VIEN,VSDTM
  1. S BDATE=$$DATE^BQIUL1(TMFRAME),EDATE=DT
  1. S TEMP=$NA(^TMP("BQITEMP",UID)) K @TEMP
  1. S TAX=$G(TAX,""),RECENT=$G(RECENT,0)
  1. I TAX'="" D
  1. . S TREF=$NA(^TMP("BQITAX",UID))
  1. . K @TREF
  1. . D BLD^BQITUTL(TAX,TREF)
  1. ;
  1. S LIEN="",QFL=0,RES=0_U_"No Test",CT=0
  1. I $G(TMFRAME)'="" D
  1. . S TIEN=""
  1. . F S TIEN=$O(@TREF@(TIEN)) Q:TIEN="" D
  1. .. S EDT=9999999-BDATE,BDT=(9999999-EDATE)-.001
  1. .. I $P($G(^LAB(60,TIEN,0)),U,4)="MI" D Q
  1. ... D MIC(BQDFN,TIEN,EDT,BDT,.MICRO)
  1. ... M @TEMP=MICRO
  1. ... K MICRO
  1. .. F S BDT=$O(^AUPNVLAB("AA",BQDFN,TIEN,BDT)) Q:BDT=""!(BDT>EDT) D
  1. ... S LIEN=""
  1. ... F S LIEN=$O(^AUPNVLAB("AA",BQDFN,TIEN,BDT,LIEN)) Q:LIEN="" D
  1. .... S VALUE=$P(^AUPNVLAB(LIEN,0),U,4) I VALUE="" Q
  1. .... S VIEN=$P(^AUPNVLAB(LIEN,0),U,3) I VIEN="" Q
  1. .... S FLAG=$P($G(^AUPNVLAB(LIEN,11)),U,9) I FLAG="" Q
  1. .... I FLAG'="R"&(FLAG'="M") Q
  1. .... S VSDTM=$$GET1^DIQ(9000010,VIEN_",",.01,"I")\1 I VSDTM=0 Q
  1. .... ;I $G(TMFRAME)'="",VSDTM<BDATE Q
  1. .... ; quit if deleted flag
  1. .... I $P($G(^AUPNVSIT(VIEN,0)),U,11)=1 Q
  1. .... I $P($G(^AUPNVLAB(LIEN,11)),U,9)="D" Q
  1. .... S @TEMP@(VSDTM,VIEN,LIEN)=VALUE_U_"9000010.09"_U_TIEN
  1. ;
  1. I $G(TMFRAME)="" D
  1. . S LIEN=""
  1. . F S LIEN=$O(^AUPNVLAB("AC",BQDFN,LIEN),-1) Q:LIEN="" D
  1. .. S TIEN=$P($G(^AUPNVLAB(LIEN,0)),U,1) I TIEN="" Q
  1. .. I '$D(@TREF@(TIEN)) Q
  1. .. S VALUE=$P(^AUPNVLAB(LIEN,0),U,4) I VALUE="" Q
  1. .. S VIEN=$P(^AUPNVLAB(LIEN,0),U,3) I VIEN="" Q
  1. .. S VSDTM=$$GET1^DIQ(9000010,VIEN_",",.01,"I")\1 I VSDTM=0 Q
  1. .. ;I $G(TMFRAME)'="",VSDTM<BDATE Q
  1. .. ; quit if deleted flag
  1. .. I $P($G(^AUPNVSIT(VIEN,0)),U,11)=1 Q
  1. .. I $P($G(^AUPNVLAB(LIEN,11)),U,9)="D" Q
  1. .. S @TEMP@(VSDTM,VIEN,LIEN)=VALUE_U_"9000010.09"_U_TIEN
  1. . F S LIEN=$O(^AUPNVMIC("AC",BQDFN,LIEN),-1) Q:LIEN="" D
  1. .. S TIEN=$P($G(^AUPNVMIC(LIEN,0)),U,1) I TIEN="" Q
  1. .. I '$D(@TREF@(TIEN)) Q
  1. .. S VALUE=$P(^AUPNVMIC(LIEN,0),U,7) I VALUE="" Q
  1. .. S VIEN=$P(^AUPNVMIC(LIEN,0),U,3) I VIEN="" Q
  1. .. S VSDTM=$$GET1^DIQ(9000010,VIEN_",",.01,"I")\1 I VSDTM=0 Q
  1. .. ; quit if deleted flag
  1. .. I $P($G(^AUPNVSIT(VIEN,0)),U,11)=1 Q
  1. .. S FLAG=$P($G(^AUPNVMIC(LIEN,11)),U,9)
  1. .. I FLAG'="R"&(FLAG'="M") Q
  1. .. S @TEMP@(VSDTM,VIEN,LIEN)=VALUE_U_"9000010.25"_U_TIEN
  1. ;
  1. S VSDTM=""
  1. F S VSDTM=$O(@TEMP@(VSDTM),-1) Q:VSDTM="" D Q:QFL
  1. . S VIEN=$O(@TEMP@(VSDTM,""),-1),LIEN=""
  1. . F S LIEN=$O(@TEMP@(VSDTM,VIEN,LIEN),-1) Q:LIEN=""!(QFL) D
  1. .. S VALUE=$P(@TEMP@(VSDTM,VIEN,LIEN),U,1),OVALUE=VALUE
  1. .. S FILE=$P(@TEMP@(VSDTM,VIEN,LIEN),U,2)
  1. .. S TIEN=$P(@TEMP@(VSDTM,VIEN,LIEN),U,3)
  1. .. K ROPER
  1. .. S RN=""
  1. .. F S RN=$O(SEARCH(RN)) Q:RN="" D Q:QFL
  1. ... S OPER=$P(SEARCH(RN),U,2),RESULT=$P(SEARCH(RN),U,1),OPER2=$P(SEARCH(RN),U,4),RES2=$P(SEARCH(RN),U,3)
  1. ... D RCHK
  1. K @TEMP
  1. Q RES
  1. ;
  1. RCHK ;
  1. I OPER="'=",RESULT="",VALUE'="" S RES=1_U_$$FMTE^BQIUL1(VSDTM)_U_VALUE_U_VIEN_U_LIEN_U_TIEN_U_FILE,QFL=1 Q
  1. ;
  1. I RESULT'?.N,VALUE?.N Q
  1. ;
  1. I RESULT="POS",$E(VALUE,1)'?.N,'$$POSITIVE^BQITRUTL(VALUE) Q
  1. I RESULT="POS",$E(VALUE,1)'?.N,$$POSITIVE^BQITRUTL(VALUE) D Q
  1. . S RES=1_U_$$FMTE^BQIUL1(VSDTM)_U_VALUE_U_VIEN_U_LIEN_U_TIEN_U_FILE,QFL=1
  1. I RESULT="NEG",$E(VALUE,1)'?.N,'$$NEGATIVE^BQITRUTL(VALUE) Q
  1. I RESULT="NEG",$E(VALUE,1)'?.N,$$NEGATIVE^BQITRUTL(VALUE) D
  1. . S RES=1_U_$$FMTE^BQIUL1(VSDTM)_U_VALUE_U_VIEN_U_LIEN_U_TIEN_U_FILE,QFL=1
  1. I VALUE'?.PN,VALUE'?.N Q
  1. ;I $E(VALUE,$L(VALUE))?.P S VALUE=VALUE_"0"
  1. I $E(VALUE,$L(VALUE),$L(VALUE))?.P S VALUE=$E(VALUE,1,$L(VALUE)-1)
  1. ; if value starts with a punctuation e.g. < or >
  1. I $E(VALUE,1,1)?.P S ROPER=$E(VALUE,1,1),VALUE=$E(VALUE,2,$L(VALUE))
  1. I RES2="" D
  1. . I $G(ROPER)="",@("VALUE"_OPER_"RESULT") D Q
  1. .. S RES=1_U_$$FMTE^BQIUL1(VSDTM)_U_OVALUE_U_VIEN_U_LIEN_U_TIEN_U_FILE,QFL=1
  1. . I $G(ROPER)'="",OPER=ROPER,@("VALUE"_OPER_"RESULT") D Q
  1. .. S RES=1_U_$$FMTE^BQIUL1(VSDTM)_U_OVALUE_U_VIEN_U_LIEN_U_TIEN_U_FILE,QFL=1
  1. . I $G(ROPER)'="",OPER'=ROPER Q
  1. I RES2'="" D
  1. . I @("VALUE"_OPER_"RESULT"),@("VALUE"_OPER2_"RES2") D
  1. .. S RES=1_U_$$FMTE^BQIUL1(VSDTM)_U_OVALUE_U_VIEN_U_LIEN_U_TIEN_U_FILE,QFL=1
  1. Q
  1. ;
  1. MIC(BQDFN,TIEN,EDT,BDT,MICRO) ;EP - Look through Microbiology file
  1. NEW FLAG,LIEN,VALUE,VIEN,VSDTM
  1. K MICRO
  1. F S BDT=$O(^AUPNVMIC("AA",BQDFN,TIEN,BDT)) Q:BDT=""!(BDT>EDT) D
  1. . S LIEN=""
  1. . F S LIEN=$O(^AUPNVMIC("AA",BQDFN,TIEN,BDT,LIEN)) Q:LIEN="" D
  1. .. S VALUE=$P(^AUPNVMIC(LIEN,0),U,7) I VALUE="" Q
  1. .. S VIEN=$P(^AUPNVMIC(LIEN,0),U,3) I VIEN="" Q
  1. .. S VSDTM=$$GET1^DIQ(9000010,VIEN_",",.01,"I")\1 I VSDTM=0 Q
  1. .. ; quit if deleted flag
  1. .. I $P($G(^AUPNVSIT(VIEN,0)),U,11)=1 Q
  1. .. S FLAG=$P($G(^AUPNVMIC(LIEN,11)),U,9)
  1. .. I FLAG'="R"&(FLAG'="M") Q
  1. .. S MICRO(VSDTM,VIEN,LIEN)=VALUE_U_"9000010.25"_U_TIEN
  1. Q
  1. ;
  1. LBB(TMFRAME,RECENT,DATE,BQDFN,TAX,SEARCH,TREF) ;EP
  1. I $G(TMFRAME)'="" D
  1. . I TMFRAME'["-" Q
  1. . S TMFRAME=$P(TMFRAME,"-",2)
  1. S BDATE=$$FMADD^XLFDT(DATE,-TMFRAME),EDATE=$$FMADD^XLFDT(DATE,TMFRAME)
  1. S TEMP=$NA(^TMP("BQITEMP",UID)) K @TEMP
  1. S TAX=$G(TAX,""),RECENT=$G(RECENT,0)
  1. I TAX'="" D
  1. . S TREF=$NA(^TMP("BQITAX",UID))
  1. . K @TREF
  1. . D BLD^BQITUTL(TAX,TREF)
  1. ;
  1. S LIEN="",QFL=0,RES=0_U_"No Test",CT=0
  1. D
  1. . S TIEN=""
  1. . F S TIEN=$O(@TREF@(TIEN)) Q:TIEN="" D
  1. .. S EDT=9999999-BDATE,BDT=(9999999-EDATE)-.001
  1. .. I $P($G(^LAB(60,TIEN,0)),U,4)="MI" D Q
  1. ... D MIC(BQDFN,TIEN,EDT,BDT,.MICRO)
  1. ... M @TEMP=MICRO
  1. ... K MICRO
  1. .. F S BDT=$O(^AUPNVLAB("AA",BQDFN,TIEN,BDT)) Q:BDT=""!(BDT>EDT) D
  1. ... S LIEN=""
  1. ... F S LIEN=$O(^AUPNVLAB("AA",BQDFN,TIEN,BDT,LIEN)) Q:LIEN="" D
  1. .... S VALUE=$P(^AUPNVLAB(LIEN,0),U,4) I VALUE="" Q
  1. .... S VIEN=$P(^AUPNVLAB(LIEN,0),U,3) I VIEN="" Q
  1. .... S FLAG=$P($G(^AUPNVLAB(LIEN,11)),U,9) I FLAG="" Q
  1. .... I FLAG'="R"&(FLAG'="M") Q
  1. .... S VSDTM=$$GET1^DIQ(9000010,VIEN_",",.01,"I")\1 I VSDTM=0 Q
  1. .... ;I $G(TMFRAME)'="",VSDTM<BDATE Q
  1. .... ; quit if deleted flag
  1. .... I $P($G(^AUPNVSIT(VIEN,0)),U,11)=1 Q
  1. .... I $P($G(^AUPNVLAB(LIEN,11)),U,9)="D" Q
  1. .... S @TEMP@(VSDTM,VIEN,LIEN)=VALUE_U_"9000010.09"_U_TIEN
  1. ;
  1. S VSDTM=""
  1. F S VSDTM=$O(@TEMP@(VSDTM),-1) Q:VSDTM="" D Q:QFL
  1. . S VIEN=$O(@TEMP@(VSDTM,""),-1),LIEN=""
  1. . F S LIEN=$O(@TEMP@(VSDTM,VIEN,LIEN),-1) Q:LIEN=""!(QFL) D
  1. .. S VALUE=$P(@TEMP@(VSDTM,VIEN,LIEN),U,1),OVALUE=VALUE
  1. .. S FILE=$P(@TEMP@(VSDTM,VIEN,LIEN),U,2)
  1. .. S TIEN=$P(@TEMP@(VSDTM,VIEN,LIEN),U,3)
  1. .. K ROPER
  1. .. S RN=""
  1. .. F S RN=$O(SEARCH(RN)) Q:RN="" D Q:QFL
  1. ... S OPER=$P(SEARCH(RN),U,2),RESULT=$P(SEARCH(RN),U,1),OPER2=$P(SEARCH(RN),U,4),RES2=$P(SEARCH(RN),U,3)
  1. ... D RCHK
  1. K @TEMP
  1. Q RES