- BQICAUTL ;VNGT/HS/ALA-Utility for CA ; 29 Mar 2011 4:49 PM
- ;;2.6;ICARE MANAGEMENT SYSTEM;;Jul 07, 2017;Build 72
- ;
- TAX(TMFRAME,TAX,NIT,PTDFN,FREF,PRB,SAME,TREF) ;EP
- ; Find value for a taxonomy (TAX) or list of taxonomies (TREF)
- ; Input
- ; TMFRAME - Timeframe to search for data
- ; TAX - Taxonomy
- ; NIT - Number of iterations
- ; PTDFN - Patient IEN
- ; FREF - File number reference
- ; PRB - If Active Problem okay
- ; SAME - If NIT is allowed for the same 30 days or not (1 same 30 days okay)
- ; TREF - Multiple same resulting taxonomies (e.g. MEDs) built
- ; into reference (usually global)
- ;
- NEW RESULT,GREF,ENDT,IEN,TIEN,TEMP,QFL
- S TMFRAME=$G(TMFRAME,""),NIT=$G(NIT,1),PRB=$G(PRB,0),SAME=$G(SAME,1)
- S ENDT=$$DATE^BQIUL1(TMFRAME),RESULT=0,TREF=$G(TREF,""),TAX=$G(TAX,"")
- I TAX'="" D
- . S TREF=$NA(^TMP("BQITAX",UID))
- . K @TREF
- . D BLD^BQITUTL(TAX,TREF)
- S GREF=$$ROOT^DILFD(FREF,"",1)
- S TEMP=$NA(^TMP("BQITEMP",UID)) K @TEMP
- ;
- I PRB D
- . S IEN="",QFL=0,RESULT=0
- . F S IEN=$O(^AUPNPROB("AC",PTDFN,IEN),-1) Q:IEN="" D Q:QFL
- .. S TIEN=$$GET1^DIQ(9000011,IEN,.01,"I") I TIEN="" Q
- .. I '$D(@TREF@(TIEN)) Q
- .. ; Check class - if Family ignore
- .. I $$GET1^DIQ(9000011,IEN,.04,"I")="F" Q
- .. I $$GET1^DIQ(9000011,IEN,.12,"I")'="A" Q
- .. S VSDTM=$$PROB^BQIUL1(IEN)\1 Q:VSDTM=0
- .. I $G(TMFRAME)'="",VSDTM<ENDT Q
- .. S RESULT=1_U_VSDTM,$P(RESULT,U,4)=IEN,QFL=1
- ;
- I 'RESULT D
- . S IEN="",QFL=0,RESULT=0,CT=0
- . I $G(TMFRAME)'="" D
- .. S EDT=9999999-ENDT,BDT=""
- .. F S BDT=$O(@GREF@("AA",PTDFN,BDT)) Q:BDT=""!(BDT>EDT) D
- ... S IEN=""
- ... F S IEN=$O(@GREF@("AA",PTDFN,BDT,IEN)) Q:IEN="" D
- .... S TIEN=$$GET1^DIQ(FREF,IEN,.01,"I") I TIEN="" Q
- .... I '$D(@TREF@(TIEN)) Q
- .... S VISIT=$$GET1^DIQ(FREF,IEN,.03,"I") I VISIT="" Q
- .... I $$GET1^DIQ(9000010,VISIT,.11,"I")=1 Q
- .... S VSDTM=$$GET1^DIQ(9000010,VISIT,.01,"I")\1 Q:VSDTM=0
- .... ;I $G(TMFRAME)'="",VSDTM<ENDT Q
- .... ; Set temporary
- .... S @TEMP@(VSDTM,VISIT,IEN)=""
- . ;
- . I $G(TMFRAME)="" D
- .. F S IEN=$O(@GREF@("AC",PTDFN,IEN),-1) Q:IEN="" D
- ... S TIEN=$$GET1^DIQ(FREF,IEN,.01,"I") I TIEN="" Q
- ... I '$D(@TREF@(TIEN)) Q
- ... S VISIT=$$GET1^DIQ(FREF,IEN,.03,"I") I VISIT="" Q
- ... I $$GET1^DIQ(9000010,VISIT,.11,"I")=1 Q
- ... S VSDTM=$$GET1^DIQ(9000010,VISIT,.01,"I")\1 Q:VSDTM=0
- ... ;I $G(TMFRAME)'="",VSDTM<ENDT Q
- ... ; Set temporary
- ... S @TEMP@(VSDTM,VISIT,IEN)=""
- ;
- S VSDTM="",QFL=0
- F S VSDTM=$O(@TEMP@(VSDTM),-1) Q:VSDTM=""!(QFL) D
- . S VISIT=""
- . F S VISIT=$O(@TEMP@(VSDTM,VISIT),-1) Q:VISIT="" D Q:QFL
- .. S IEN=""
- .. F S IEN=$O(@TEMP@(VSDTM,VISIT,IEN),-1) Q:IEN="" D Q:QFL
- ... ; If result cannot be within 30 days, quit
- ... I 'SAME,$P(RESULT,U,2)=VSDTM Q
- ... S CT=CT+1
- ... I $P(RESULT,U,2)'="",(CT'>NIT) D
- .... I VSDTM'<STDT,'SAME S CT=CT-1 Q
- .... S $P(RESULT,U,2)=$P(RESULT,U,2)_";"_VSDTM
- .... S $P(RESULT,U,4)=$P(RESULT,U,4)_";"_VISIT
- .... S $P(RESULT,U,5)=$P(RESULT,U,5)_";"_IEN
- ... I $P(RESULT,U,2)="" S $P(RESULT,U,2)=VSDTM,$P(RESULT,U,4)=VISIT_U_IEN
- ... ;S $P(RESULT,U,4)=VISIT_U_IEN,CT=CT+1
- ... ;S RESULT=U_VSDTM_U_U_VISIT_U_IEN,CT=CT+1
- ... I CT=NIT S QFL=1,$P(RESULT,U,1)=1
- K @TREF
- Q RESULT
- ;
- MEAS(BQDFN,MEAS,VISIT,RESVAL,OPER) ;EP - Get measurement
- I MEAS'?.N S MEAS=$$FIND1^DIC(9999999.07,,"MX",MEAS)
- S VALUE=0
- S VDATE=$P(^AUPNVSIT(VISIT,0),U,1)\1
- S RVDT=9999999-VDATE
- S IEN=""
- F S IEN=$O(^AUPNVMSR("AA",BQDFN,MEAS,RVDT,IEN)) Q:IEN="" D
- . S RESULT=$P($G(^AUPNVMSR(IEN,0)),"^",4) I RESULT="" Q
- . I $P($G(^AUPNVMSR(IEN,2)),"^",1)=1 Q
- . ; if the new ENTERED IN ERROR field exists, exclude the record if it is marked as an error
- . I $$VFIELD^DILFD(9000010.01,2) Q:$$GET1^DIQ(9000010.01,IEN_",",2,"I")=1
- . I @(RESULT_OPER_RESVAL) S VALUE="1^"_VDATE_U_RESULT_U_VISIT_U_IEN_U_"9000010.01"
- Q VALUE
- ;
- LAB(TMFRAME,RECENT,BQDFN,TAX,SEARCH,TREF) ;EP
- ; Check for a lab test result
- ;
- ; Input
- ; TMFRAME - Time frame to search data for
- ; RECENT - 1=Only check most recent lab,0=Check all within timeframe
- ; BQDFN - Patient internal entry number
- ; TAX - Lab taxonomy to search
- ; RESULT - Lab result to check for
- ; OPER - Operand to use for result check
- ; RES2 - If range, the other result value
- ; OPER2 - If range, the other result operand
- ; TREF - Multiple same resulting taxonomies built
- ; into reference (usually global)
- ;
- NEW TEMP,EDATE,BDATE,LIEN,QFL,RES,CT,VALUE,VIEN,VSDTM
- S BDATE=$$DATE^BQIUL1(TMFRAME),EDATE=DT
- S TEMP=$NA(^TMP("BQITEMP",UID)) K @TEMP
- S TAX=$G(TAX,""),RECENT=$G(RECENT,0)
- I TAX'="" D
- . S TREF=$NA(^TMP("BQITAX",UID))
- . K @TREF
- . D BLD^BQITUTL(TAX,TREF)
- ;
- S LIEN="",QFL=0,RES=0_U_"No Test",CT=0
- I $G(TMFRAME)'="" D
- . S TIEN=""
- . F S TIEN=$O(@TREF@(TIEN)) Q:TIEN="" D
- .. S EDT=9999999-BDATE,BDT=(9999999-EDATE)-.001
- .. I $P($G(^LAB(60,TIEN,0)),U,4)="MI" D Q
- ... D MIC(BQDFN,TIEN,EDT,BDT,.MICRO)
- ... M @TEMP=MICRO
- ... K MICRO
- .. F S BDT=$O(^AUPNVLAB("AA",BQDFN,TIEN,BDT)) Q:BDT=""!(BDT>EDT) D
- ... S LIEN=""
- ... F S LIEN=$O(^AUPNVLAB("AA",BQDFN,TIEN,BDT,LIEN)) Q:LIEN="" D
- .... S VALUE=$P(^AUPNVLAB(LIEN,0),U,4) I VALUE="" Q
- .... S VIEN=$P(^AUPNVLAB(LIEN,0),U,3) I VIEN="" Q
- .... S FLAG=$P($G(^AUPNVLAB(LIEN,11)),U,9) I FLAG="" Q
- .... I FLAG'="R"&(FLAG'="M") Q
- .... S VSDTM=$$GET1^DIQ(9000010,VIEN_",",.01,"I")\1 I VSDTM=0 Q
- .... ;I $G(TMFRAME)'="",VSDTM<BDATE Q
- .... ; quit if deleted flag
- .... I $P($G(^AUPNVSIT(VIEN,0)),U,11)=1 Q
- .... I $P($G(^AUPNVLAB(LIEN,11)),U,9)="D" Q
- .... S @TEMP@(VSDTM,VIEN,LIEN)=VALUE_U_"9000010.09"_U_TIEN
- ;
- I $G(TMFRAME)="" D
- . S LIEN=""
- . F S LIEN=$O(^AUPNVLAB("AC",BQDFN,LIEN),-1) Q:LIEN="" D
- .. S TIEN=$P($G(^AUPNVLAB(LIEN,0)),U,1) I TIEN="" Q
- .. I '$D(@TREF@(TIEN)) Q
- .. S VALUE=$P(^AUPNVLAB(LIEN,0),U,4) I VALUE="" Q
- .. S VIEN=$P(^AUPNVLAB(LIEN,0),U,3) I VIEN="" Q
- .. S VSDTM=$$GET1^DIQ(9000010,VIEN_",",.01,"I")\1 I VSDTM=0 Q
- .. ;I $G(TMFRAME)'="",VSDTM<BDATE Q
- .. ; quit if deleted flag
- .. I $P($G(^AUPNVSIT(VIEN,0)),U,11)=1 Q
- .. I $P($G(^AUPNVLAB(LIEN,11)),U,9)="D" Q
- .. S @TEMP@(VSDTM,VIEN,LIEN)=VALUE_U_"9000010.09"_U_TIEN
- . F S LIEN=$O(^AUPNVMIC("AC",BQDFN,LIEN),-1) Q:LIEN="" D
- .. S TIEN=$P($G(^AUPNVMIC(LIEN,0)),U,1) I TIEN="" Q
- .. I '$D(@TREF@(TIEN)) Q
- .. S VALUE=$P(^AUPNVMIC(LIEN,0),U,7) I VALUE="" Q
- .. S VIEN=$P(^AUPNVMIC(LIEN,0),U,3) I VIEN="" Q
- .. S VSDTM=$$GET1^DIQ(9000010,VIEN_",",.01,"I")\1 I VSDTM=0 Q
- .. ; quit if deleted flag
- .. I $P($G(^AUPNVSIT(VIEN,0)),U,11)=1 Q
- .. S FLAG=$P($G(^AUPNVMIC(LIEN,11)),U,9)
- .. I FLAG'="R"&(FLAG'="M") Q
- .. S @TEMP@(VSDTM,VIEN,LIEN)=VALUE_U_"9000010.25"_U_TIEN
- ;
- S VSDTM=""
- F S VSDTM=$O(@TEMP@(VSDTM),-1) Q:VSDTM="" D Q:QFL
- . S VIEN=$O(@TEMP@(VSDTM,""),-1),LIEN=""
- . F S LIEN=$O(@TEMP@(VSDTM,VIEN,LIEN),-1) Q:LIEN=""!(QFL) D
- .. S VALUE=$P(@TEMP@(VSDTM,VIEN,LIEN),U,1),OVALUE=VALUE
- .. S FILE=$P(@TEMP@(VSDTM,VIEN,LIEN),U,2)
- .. S TIEN=$P(@TEMP@(VSDTM,VIEN,LIEN),U,3)
- .. K ROPER
- .. S RN=""
- .. F S RN=$O(SEARCH(RN)) Q:RN="" D Q:QFL
- ... 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)
- ... D RCHK
- K @TEMP
- Q RES
- ;
- RCHK ;
- I OPER="'=",RESULT="",VALUE'="" S RES=1_U_$$FMTE^BQIUL1(VSDTM)_U_VALUE_U_VIEN_U_LIEN_U_TIEN_U_FILE,QFL=1 Q
- ;
- I RESULT'?.N,VALUE?.N Q
- ;
- I RESULT="POS",$E(VALUE,1)'?.N,'$$POSITIVE^BQITRUTL(VALUE) Q
- I RESULT="POS",$E(VALUE,1)'?.N,$$POSITIVE^BQITRUTL(VALUE) D Q
- . S RES=1_U_$$FMTE^BQIUL1(VSDTM)_U_VALUE_U_VIEN_U_LIEN_U_TIEN_U_FILE,QFL=1
- I RESULT="NEG",$E(VALUE,1)'?.N,'$$NEGATIVE^BQITRUTL(VALUE) Q
- I RESULT="NEG",$E(VALUE,1)'?.N,$$NEGATIVE^BQITRUTL(VALUE) D
- . S RES=1_U_$$FMTE^BQIUL1(VSDTM)_U_VALUE_U_VIEN_U_LIEN_U_TIEN_U_FILE,QFL=1
- I VALUE'?.PN,VALUE'?.N Q
- ;I $E(VALUE,$L(VALUE))?.P S VALUE=VALUE_"0"
- I $E(VALUE,$L(VALUE),$L(VALUE))?.P S VALUE=$E(VALUE,1,$L(VALUE)-1)
- ; if value starts with a punctuation e.g. < or >
- I $E(VALUE,1,1)?.P S ROPER=$E(VALUE,1,1),VALUE=$E(VALUE,2,$L(VALUE))
- I RES2="" D
- . I $G(ROPER)="",@("VALUE"_OPER_"RESULT") D Q
- .. S RES=1_U_$$FMTE^BQIUL1(VSDTM)_U_OVALUE_U_VIEN_U_LIEN_U_TIEN_U_FILE,QFL=1
- . I $G(ROPER)'="",OPER=ROPER,@("VALUE"_OPER_"RESULT") D Q
- .. S RES=1_U_$$FMTE^BQIUL1(VSDTM)_U_OVALUE_U_VIEN_U_LIEN_U_TIEN_U_FILE,QFL=1
- . I $G(ROPER)'="",OPER'=ROPER Q
- I RES2'="" D
- . I @("VALUE"_OPER_"RESULT"),@("VALUE"_OPER2_"RES2") D
- .. S RES=1_U_$$FMTE^BQIUL1(VSDTM)_U_OVALUE_U_VIEN_U_LIEN_U_TIEN_U_FILE,QFL=1
- Q
- ;
- MIC(BQDFN,TIEN,EDT,BDT,MICRO) ;EP - Look through Microbiology file
- NEW FLAG,LIEN,VALUE,VIEN,VSDTM
- K MICRO
- F S BDT=$O(^AUPNVMIC("AA",BQDFN,TIEN,BDT)) Q:BDT=""!(BDT>EDT) D
- . S LIEN=""
- . F S LIEN=$O(^AUPNVMIC("AA",BQDFN,TIEN,BDT,LIEN)) Q:LIEN="" D
- .. S VALUE=$P(^AUPNVMIC(LIEN,0),U,7) I VALUE="" Q
- .. S VIEN=$P(^AUPNVMIC(LIEN,0),U,3) I VIEN="" Q
- .. S VSDTM=$$GET1^DIQ(9000010,VIEN_",",.01,"I")\1 I VSDTM=0 Q
- .. ; quit if deleted flag
- .. I $P($G(^AUPNVSIT(VIEN,0)),U,11)=1 Q
- .. S FLAG=$P($G(^AUPNVMIC(LIEN,11)),U,9)
- .. I FLAG'="R"&(FLAG'="M") Q
- .. S MICRO(VSDTM,VIEN,LIEN)=VALUE_U_"9000010.25"_U_TIEN
- Q
- ;
- LBB(TMFRAME,RECENT,DATE,BQDFN,TAX,SEARCH,TREF) ;EP
- I $G(TMFRAME)'="" D
- . I TMFRAME'["-" Q
- . S TMFRAME=$P(TMFRAME,"-",2)
- S BDATE=$$FMADD^XLFDT(DATE,-TMFRAME),EDATE=$$FMADD^XLFDT(DATE,TMFRAME)
- S TEMP=$NA(^TMP("BQITEMP",UID)) K @TEMP
- S TAX=$G(TAX,""),RECENT=$G(RECENT,0)
- I TAX'="" D
- . S TREF=$NA(^TMP("BQITAX",UID))
- . K @TREF
- . D BLD^BQITUTL(TAX,TREF)
- ;
- S LIEN="",QFL=0,RES=0_U_"No Test",CT=0
- D
- . S TIEN=""
- . F S TIEN=$O(@TREF@(TIEN)) Q:TIEN="" D
- .. S EDT=9999999-BDATE,BDT=(9999999-EDATE)-.001
- .. I $P($G(^LAB(60,TIEN,0)),U,4)="MI" D Q
- ... D MIC(BQDFN,TIEN,EDT,BDT,.MICRO)
- ... M @TEMP=MICRO
- ... K MICRO
- .. F S BDT=$O(^AUPNVLAB("AA",BQDFN,TIEN,BDT)) Q:BDT=""!(BDT>EDT) D
- ... S LIEN=""
- ... F S LIEN=$O(^AUPNVLAB("AA",BQDFN,TIEN,BDT,LIEN)) Q:LIEN="" D
- .... S VALUE=$P(^AUPNVLAB(LIEN,0),U,4) I VALUE="" Q
- .... S VIEN=$P(^AUPNVLAB(LIEN,0),U,3) I VIEN="" Q
- .... S FLAG=$P($G(^AUPNVLAB(LIEN,11)),U,9) I FLAG="" Q
- .... I FLAG'="R"&(FLAG'="M") Q
- .... S VSDTM=$$GET1^DIQ(9000010,VIEN_",",.01,"I")\1 I VSDTM=0 Q
- .... ;I $G(TMFRAME)'="",VSDTM<BDATE Q
- .... ; quit if deleted flag
- .... I $P($G(^AUPNVSIT(VIEN,0)),U,11)=1 Q
- .... I $P($G(^AUPNVLAB(LIEN,11)),U,9)="D" Q
- .... S @TEMP@(VSDTM,VIEN,LIEN)=VALUE_U_"9000010.09"_U_TIEN
- ;
- S VSDTM=""
- F S VSDTM=$O(@TEMP@(VSDTM),-1) Q:VSDTM="" D Q:QFL
- . S VIEN=$O(@TEMP@(VSDTM,""),-1),LIEN=""
- . F S LIEN=$O(@TEMP@(VSDTM,VIEN,LIEN),-1) Q:LIEN=""!(QFL) D
- .. S VALUE=$P(@TEMP@(VSDTM,VIEN,LIEN),U,1),OVALUE=VALUE
- .. S FILE=$P(@TEMP@(VSDTM,VIEN,LIEN),U,2)
- .. S TIEN=$P(@TEMP@(VSDTM,VIEN,LIEN),U,3)
- .. K ROPER
- .. S RN=""
- .. F S RN=$O(SEARCH(RN)) Q:RN="" D Q:QFL
- ... 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)
- ... D RCHK
- K @TEMP
- Q RES
- BQICAUTL ;VNGT/HS/ALA-Utility for CA ; 29 Mar 2011 4:49 PM
- +1 ;;2.6;ICARE MANAGEMENT SYSTEM;;Jul 07, 2017;Build 72
- +2 ;
- TAX(TMFRAME,TAX,NIT,PTDFN,FREF,PRB,SAME,TREF) ;EP
- +1 ; Find value for a taxonomy (TAX) or list of taxonomies (TREF)
- +2 ; Input
- +3 ; TMFRAME - Timeframe to search for data
- +4 ; TAX - Taxonomy
- +5 ; NIT - Number of iterations
- +6 ; PTDFN - Patient IEN
- +7 ; FREF - File number reference
- +8 ; PRB - If Active Problem okay
- +9 ; SAME - If NIT is allowed for the same 30 days or not (1 same 30 days okay)
- +10 ; TREF - Multiple same resulting taxonomies (e.g. MEDs) built
- +11 ; into reference (usually global)
- +12 ;
- +13 NEW RESULT,GREF,ENDT,IEN,TIEN,TEMP,QFL
- +14 SET TMFRAME=$GET(TMFRAME,"")
- SET NIT=$GET(NIT,1)
- SET PRB=$GET(PRB,0)
- SET SAME=$GET(SAME,1)
- +15 SET ENDT=$$DATE^BQIUL1(TMFRAME)
- SET RESULT=0
- SET TREF=$GET(TREF,"")
- SET TAX=$GET(TAX,"")
- +16 IF TAX'=""
- Begin DoDot:1
- +17 SET TREF=$NAME(^TMP("BQITAX",UID))
- +18 KILL @TREF
- +19 DO BLD^BQITUTL(TAX,TREF)
- End DoDot:1
- +20 SET GREF=$$ROOT^DILFD(FREF,"",1)
- +21 SET TEMP=$NAME(^TMP("BQITEMP",UID))
- KILL @TEMP
- +22 ;
- +23 IF PRB
- Begin DoDot:1
- +24 SET IEN=""
- SET QFL=0
- SET RESULT=0
- +25 FOR
- SET IEN=$ORDER(^AUPNPROB("AC",PTDFN,IEN),-1)
- IF IEN=""
- QUIT
- Begin DoDot:2
- +26 SET TIEN=$$GET1^DIQ(9000011,IEN,.01,"I")
- IF TIEN=""
- QUIT
- +27 IF '$DATA(@TREF@(TIEN))
- QUIT
- +28 ; Check class - if Family ignore
- +29 IF $$GET1^DIQ(9000011,IEN,.04,"I")="F"
- QUIT
- +30 IF $$GET1^DIQ(9000011,IEN,.12,"I")'="A"
- QUIT
- +31 SET VSDTM=$$PROB^BQIUL1(IEN)\1
- IF VSDTM=0
- QUIT
- +32 IF $GET(TMFRAME)'=""
- IF VSDTM<ENDT
- QUIT
- +33 SET RESULT=1_U_VSDTM
- SET $PIECE(RESULT,U,4)=IEN
- SET QFL=1
- End DoDot:2
- IF QFL
- QUIT
- End DoDot:1
- +34 ;
- +35 IF 'RESULT
- Begin DoDot:1
- +36 SET IEN=""
- SET QFL=0
- SET RESULT=0
- SET CT=0
- +37 IF $GET(TMFRAME)'=""
- Begin DoDot:2
- +38 SET EDT=9999999-ENDT
- SET BDT=""
- +39 FOR
- SET BDT=$ORDER(@GREF@("AA",PTDFN,BDT))
- IF BDT=""!(BDT>EDT)
- QUIT
- Begin DoDot:3
- +40 SET IEN=""
- +41 FOR
- SET IEN=$ORDER(@GREF@("AA",PTDFN,BDT,IEN))
- IF IEN=""
- QUIT
- Begin DoDot:4
- +42 SET TIEN=$$GET1^DIQ(FREF,IEN,.01,"I")
- IF TIEN=""
- QUIT
- +43 IF '$DATA(@TREF@(TIEN))
- QUIT
- +44 SET VISIT=$$GET1^DIQ(FREF,IEN,.03,"I")
- IF VISIT=""
- QUIT
- +45 IF $$GET1^DIQ(9000010,VISIT,.11,"I")=1
- QUIT
- +46 SET VSDTM=$$GET1^DIQ(9000010,VISIT,.01,"I")\1
- IF VSDTM=0
- QUIT
- +47 ;I $G(TMFRAME)'="",VSDTM<ENDT Q
- +48 ; Set temporary
- +49 SET @TEMP@(VSDTM,VISIT,IEN)=""
- End DoDot:4
- End DoDot:3
- End DoDot:2
- +50 ;
- +51 IF $GET(TMFRAME)=""
- Begin DoDot:2
- +52 FOR
- SET IEN=$ORDER(@GREF@("AC",PTDFN,IEN),-1)
- IF IEN=""
- QUIT
- Begin DoDot:3
- +53 SET TIEN=$$GET1^DIQ(FREF,IEN,.01,"I")
- IF TIEN=""
- QUIT
- +54 IF '$DATA(@TREF@(TIEN))
- QUIT
- +55 SET VISIT=$$GET1^DIQ(FREF,IEN,.03,"I")
- IF VISIT=""
- QUIT
- +56 IF $$GET1^DIQ(9000010,VISIT,.11,"I")=1
- QUIT
- +57 SET VSDTM=$$GET1^DIQ(9000010,VISIT,.01,"I")\1
- IF VSDTM=0
- QUIT
- +58 ;I $G(TMFRAME)'="",VSDTM<ENDT Q
- +59 ; Set temporary
- +60 SET @TEMP@(VSDTM,VISIT,IEN)=""
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +61 ;
- +62 SET VSDTM=""
- SET QFL=0
- +63 FOR
- SET VSDTM=$ORDER(@TEMP@(VSDTM),-1)
- IF VSDTM=""!(QFL)
- QUIT
- Begin DoDot:1
- +64 SET VISIT=""
- +65 FOR
- SET VISIT=$ORDER(@TEMP@(VSDTM,VISIT),-1)
- IF VISIT=""
- QUIT
- Begin DoDot:2
- +66 SET IEN=""
- +67 FOR
- SET IEN=$ORDER(@TEMP@(VSDTM,VISIT,IEN),-1)
- IF IEN=""
- QUIT
- Begin DoDot:3
- +68 ; If result cannot be within 30 days, quit
- +69 IF 'SAME
- IF $PIECE(RESULT,U,2)=VSDTM
- QUIT
- +70 SET CT=CT+1
- +71 IF $PIECE(RESULT,U,2)'=""
- IF (CT'>NIT)
- Begin DoDot:4
- +72 IF VSDTM'<STDT
- IF 'SAME
- SET CT=CT-1
- QUIT
- +73 SET $PIECE(RESULT,U,2)=$PIECE(RESULT,U,2)_";"_VSDTM
- +74 SET $PIECE(RESULT,U,4)=$PIECE(RESULT,U,4)_";"_VISIT
- +75 SET $PIECE(RESULT,U,5)=$PIECE(RESULT,U,5)_";"_IEN
- End DoDot:4
- +76 IF $PIECE(RESULT,U,2)=""
- SET $PIECE(RESULT,U,2)=VSDTM
- SET $PIECE(RESULT,U,4)=VISIT_U_IEN
- +77 ;S $P(RESULT,U,4)=VISIT_U_IEN,CT=CT+1
- +78 ;S RESULT=U_VSDTM_U_U_VISIT_U_IEN,CT=CT+1
- +79 IF CT=NIT
- SET QFL=1
- SET $PIECE(RESULT,U,1)=1
- End DoDot:3
- IF QFL
- QUIT
- End DoDot:2
- IF QFL
- QUIT
- End DoDot:1
- +80 KILL @TREF
- +81 QUIT RESULT
- +82 ;
- MEAS(BQDFN,MEAS,VISIT,RESVAL,OPER) ;EP - Get measurement
- +1 IF MEAS'?.N
- SET MEAS=$$FIND1^DIC(9999999.07,,"MX",MEAS)
- +2 SET VALUE=0
- +3 SET VDATE=$PIECE(^AUPNVSIT(VISIT,0),U,1)\1
- +4 SET RVDT=9999999-VDATE
- +5 SET IEN=""
- +6 FOR
- SET IEN=$ORDER(^AUPNVMSR("AA",BQDFN,MEAS,RVDT,IEN))
- IF IEN=""
- QUIT
- Begin DoDot:1
- +7 SET RESULT=$PIECE($GET(^AUPNVMSR(IEN,0)),"^",4)
- IF RESULT=""
- QUIT
- +8 IF $PIECE($GET(^AUPNVMSR(IEN,2)),"^",1)=1
- QUIT
- +9 ; if the new ENTERED IN ERROR field exists, exclude the record if it is marked as an error
- +10 IF $$VFIELD^DILFD(9000010.01,2)
- IF $$GET1^DIQ(9000010.01,IEN_",",2,"I")=1
- QUIT
- +11 IF @(RESULT_OPER_RESVAL)
- SET VALUE="1^"_VDATE_U_RESULT_U_VISIT_U_IEN_U_"9000010.01"
- End DoDot:1
- +12 QUIT VALUE
- +13 ;
- LAB(TMFRAME,RECENT,BQDFN,TAX,SEARCH,TREF) ;EP
- +1 ; Check for a lab test result
- +2 ;
- +3 ; Input
- +4 ; TMFRAME - Time frame to search data for
- +5 ; RECENT - 1=Only check most recent lab,0=Check all within timeframe
- +6 ; BQDFN - Patient internal entry number
- +7 ; TAX - Lab taxonomy to search
- +8 ; RESULT - Lab result to check for
- +9 ; OPER - Operand to use for result check
- +10 ; RES2 - If range, the other result value
- +11 ; OPER2 - If range, the other result operand
- +12 ; TREF - Multiple same resulting taxonomies built
- +13 ; into reference (usually global)
- +14 ;
- +15 NEW TEMP,EDATE,BDATE,LIEN,QFL,RES,CT,VALUE,VIEN,VSDTM
- +16 SET BDATE=$$DATE^BQIUL1(TMFRAME)
- SET EDATE=DT
- +17 SET TEMP=$NAME(^TMP("BQITEMP",UID))
- KILL @TEMP
- +18 SET TAX=$GET(TAX,"")
- SET RECENT=$GET(RECENT,0)
- +19 IF TAX'=""
- Begin DoDot:1
- +20 SET TREF=$NAME(^TMP("BQITAX",UID))
- +21 KILL @TREF
- +22 DO BLD^BQITUTL(TAX,TREF)
- End DoDot:1
- +23 ;
- +24 SET LIEN=""
- SET QFL=0
- SET RES=0_U_"No Test"
- SET CT=0
- +25 IF $GET(TMFRAME)'=""
- Begin DoDot:1
- +26 SET TIEN=""
- +27 FOR
- SET TIEN=$ORDER(@TREF@(TIEN))
- IF TIEN=""
- QUIT
- Begin DoDot:2
- +28 SET EDT=9999999-BDATE
- SET BDT=(9999999-EDATE)-.001
- +29 IF $PIECE($GET(^LAB(60,TIEN,0)),U,4)="MI"
- Begin DoDot:3
- +30 DO MIC(BQDFN,TIEN,EDT,BDT,.MICRO)
- +31 MERGE @TEMP=MICRO
- +32 KILL MICRO
- End DoDot:3
- QUIT
- +33 FOR
- SET BDT=$ORDER(^AUPNVLAB("AA",BQDFN,TIEN,BDT))
- IF BDT=""!(BDT>EDT)
- QUIT
- Begin DoDot:3
- +34 SET LIEN=""
- +35 FOR
- SET LIEN=$ORDER(^AUPNVLAB("AA",BQDFN,TIEN,BDT,LIEN))
- IF LIEN=""
- QUIT
- Begin DoDot:4
- +36 SET VALUE=$PIECE(^AUPNVLAB(LIEN,0),U,4)
- IF VALUE=""
- QUIT
- +37 SET VIEN=$PIECE(^AUPNVLAB(LIEN,0),U,3)
- IF VIEN=""
- QUIT
- +38 SET FLAG=$PIECE($GET(^AUPNVLAB(LIEN,11)),U,9)
- IF FLAG=""
- QUIT
- +39 IF FLAG'="R"&(FLAG'="M")
- QUIT
- +40 SET VSDTM=$$GET1^DIQ(9000010,VIEN_",",.01,"I")\1
- IF VSDTM=0
- QUIT
- +41 ;I $G(TMFRAME)'="",VSDTM<BDATE Q
- +42 ; quit if deleted flag
- +43 IF $PIECE($GET(^AUPNVSIT(VIEN,0)),U,11)=1
- QUIT
- +44 IF $PIECE($GET(^AUPNVLAB(LIEN,11)),U,9)="D"
- QUIT
- +45 SET @TEMP@(VSDTM,VIEN,LIEN)=VALUE_U_"9000010.09"_U_TIEN
- End DoDot:4
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +46 ;
- +47 IF $GET(TMFRAME)=""
- Begin DoDot:1
- +48 SET LIEN=""
- +49 FOR
- SET LIEN=$ORDER(^AUPNVLAB("AC",BQDFN,LIEN),-1)
- IF LIEN=""
- QUIT
- Begin DoDot:2
- +50 SET TIEN=$PIECE($GET(^AUPNVLAB(LIEN,0)),U,1)
- IF TIEN=""
- QUIT
- +51 IF '$DATA(@TREF@(TIEN))
- QUIT
- +52 SET VALUE=$PIECE(^AUPNVLAB(LIEN,0),U,4)
- IF VALUE=""
- QUIT
- +53 SET VIEN=$PIECE(^AUPNVLAB(LIEN,0),U,3)
- IF VIEN=""
- QUIT
- +54 SET VSDTM=$$GET1^DIQ(9000010,VIEN_",",.01,"I")\1
- IF VSDTM=0
- QUIT
- +55 ;I $G(TMFRAME)'="",VSDTM<BDATE Q
- +56 ; quit if deleted flag
- +57 IF $PIECE($GET(^AUPNVSIT(VIEN,0)),U,11)=1
- QUIT
- +58 IF $PIECE($GET(^AUPNVLAB(LIEN,11)),U,9)="D"
- QUIT
- +59 SET @TEMP@(VSDTM,VIEN,LIEN)=VALUE_U_"9000010.09"_U_TIEN
- End DoDot:2
- +60 FOR
- SET LIEN=$ORDER(^AUPNVMIC("AC",BQDFN,LIEN),-1)
- IF LIEN=""
- QUIT
- Begin DoDot:2
- +61 SET TIEN=$PIECE($GET(^AUPNVMIC(LIEN,0)),U,1)
- IF TIEN=""
- QUIT
- +62 IF '$DATA(@TREF@(TIEN))
- QUIT
- +63 SET VALUE=$PIECE(^AUPNVMIC(LIEN,0),U,7)
- IF VALUE=""
- QUIT
- +64 SET VIEN=$PIECE(^AUPNVMIC(LIEN,0),U,3)
- IF VIEN=""
- QUIT
- +65 SET VSDTM=$$GET1^DIQ(9000010,VIEN_",",.01,"I")\1
- IF VSDTM=0
- QUIT
- +66 ; quit if deleted flag
- +67 IF $PIECE($GET(^AUPNVSIT(VIEN,0)),U,11)=1
- QUIT
- +68 SET FLAG=$PIECE($GET(^AUPNVMIC(LIEN,11)),U,9)
- +69 IF FLAG'="R"&(FLAG'="M")
- QUIT
- +70 SET @TEMP@(VSDTM,VIEN,LIEN)=VALUE_U_"9000010.25"_U_TIEN
- End DoDot:2
- End DoDot:1
- +71 ;
- +72 SET VSDTM=""
- +73 FOR
- SET VSDTM=$ORDER(@TEMP@(VSDTM),-1)
- IF VSDTM=""
- QUIT
- Begin DoDot:1
- +74 SET VIEN=$ORDER(@TEMP@(VSDTM,""),-1)
- SET LIEN=""
- +75 FOR
- SET LIEN=$ORDER(@TEMP@(VSDTM,VIEN,LIEN),-1)
- IF LIEN=""!(QFL)
- QUIT
- Begin DoDot:2
- +76 SET VALUE=$PIECE(@TEMP@(VSDTM,VIEN,LIEN),U,1)
- SET OVALUE=VALUE
- +77 SET FILE=$PIECE(@TEMP@(VSDTM,VIEN,LIEN),U,2)
- +78 SET TIEN=$PIECE(@TEMP@(VSDTM,VIEN,LIEN),U,3)
- +79 KILL ROPER
- +80 SET RN=""
- +81 FOR
- SET RN=$ORDER(SEARCH(RN))
- IF RN=""
- QUIT
- Begin DoDot:3
- +82 SET OPER=$PIECE(SEARCH(RN),U,2)
- SET RESULT=$PIECE(SEARCH(RN),U,1)
- SET OPER2=$PIECE(SEARCH(RN),U,4)
- SET RES2=$PIECE(SEARCH(RN),U,3)
- +83 DO RCHK
- End DoDot:3
- IF QFL
- QUIT
- End DoDot:2
- End DoDot:1
- IF QFL
- QUIT
- +84 KILL @TEMP
- +85 QUIT RES
- +86 ;
- RCHK ;
- +1 IF OPER="'="
- IF RESULT=""
- IF VALUE'=""
- SET RES=1_U_$$FMTE^BQIUL1(VSDTM)_U_VALUE_U_VIEN_U_LIEN_U_TIEN_U_FILE
- SET QFL=1
- QUIT
- +2 ;
- +3 IF RESULT'?.N
- IF VALUE?.N
- QUIT
- +4 ;
- +5 IF RESULT="POS"
- IF $EXTRACT(VALUE,1)'?.N
- IF '$$POSITIVE^BQITRUTL(VALUE)
- QUIT
- +6 IF RESULT="POS"
- IF $EXTRACT(VALUE,1)'?.N
- IF $$POSITIVE^BQITRUTL(VALUE)
- Begin DoDot:1
- +7 SET RES=1_U_$$FMTE^BQIUL1(VSDTM)_U_VALUE_U_VIEN_U_LIEN_U_TIEN_U_FILE
- SET QFL=1
- End DoDot:1
- QUIT
- +8 IF RESULT="NEG"
- IF $EXTRACT(VALUE,1)'?.N
- IF '$$NEGATIVE^BQITRUTL(VALUE)
- QUIT
- +9 IF RESULT="NEG"
- IF $EXTRACT(VALUE,1)'?.N
- IF $$NEGATIVE^BQITRUTL(VALUE)
- Begin DoDot:1
- +10 SET RES=1_U_$$FMTE^BQIUL1(VSDTM)_U_VALUE_U_VIEN_U_LIEN_U_TIEN_U_FILE
- SET QFL=1
- End DoDot:1
- +11 IF VALUE'?.PN
- IF VALUE'?.N
- QUIT
- +12 ;I $E(VALUE,$L(VALUE))?.P S VALUE=VALUE_"0"
- +13 IF $EXTRACT(VALUE,$LENGTH(VALUE),$LENGTH(VALUE))?.P
- SET VALUE=$EXTRACT(VALUE,1,$LENGTH(VALUE)-1)
- +14 ; if value starts with a punctuation e.g. < or >
- +15 IF $EXTRACT(VALUE,1,1)?.P
- SET ROPER=$EXTRACT(VALUE,1,1)
- SET VALUE=$EXTRACT(VALUE,2,$LENGTH(VALUE))
- +16 IF RES2=""
- Begin DoDot:1
- +17 IF $GET(ROPER)=""
- IF @("VALUE"_OPER_"RESULT")
- Begin DoDot:2
- +18 SET RES=1_U_$$FMTE^BQIUL1(VSDTM)_U_OVALUE_U_VIEN_U_LIEN_U_TIEN_U_FILE
- SET QFL=1
- End DoDot:2
- QUIT
- +19 IF $GET(ROPER)'=""
- IF OPER=ROPER
- IF @("VALUE"_OPER_"RESULT")
- Begin DoDot:2
- +20 SET RES=1_U_$$FMTE^BQIUL1(VSDTM)_U_OVALUE_U_VIEN_U_LIEN_U_TIEN_U_FILE
- SET QFL=1
- End DoDot:2
- QUIT
- +21 IF $GET(ROPER)'=""
- IF OPER'=ROPER
- QUIT
- End DoDot:1
- +22 IF RES2'=""
- Begin DoDot:1
- +23 IF @("VALUE"_OPER_"RESULT")
- IF @("VALUE"_OPER2_"RES2")
- Begin DoDot:2
- +24 SET RES=1_U_$$FMTE^BQIUL1(VSDTM)_U_OVALUE_U_VIEN_U_LIEN_U_TIEN_U_FILE
- SET QFL=1
- End DoDot:2
- End DoDot:1
- +25 QUIT
- +26 ;
- MIC(BQDFN,TIEN,EDT,BDT,MICRO) ;EP - Look through Microbiology file
- +1 NEW FLAG,LIEN,VALUE,VIEN,VSDTM
- +2 KILL MICRO
- +3 FOR
- SET BDT=$ORDER(^AUPNVMIC("AA",BQDFN,TIEN,BDT))
- IF BDT=""!(BDT>EDT)
- QUIT
- Begin DoDot:1
- +4 SET LIEN=""
- +5 FOR
- SET LIEN=$ORDER(^AUPNVMIC("AA",BQDFN,TIEN,BDT,LIEN))
- IF LIEN=""
- QUIT
- Begin DoDot:2
- +6 SET VALUE=$PIECE(^AUPNVMIC(LIEN,0),U,7)
- IF VALUE=""
- QUIT
- +7 SET VIEN=$PIECE(^AUPNVMIC(LIEN,0),U,3)
- IF VIEN=""
- QUIT
- +8 SET VSDTM=$$GET1^DIQ(9000010,VIEN_",",.01,"I")\1
- IF VSDTM=0
- QUIT
- +9 ; quit if deleted flag
- +10 IF $PIECE($GET(^AUPNVSIT(VIEN,0)),U,11)=1
- QUIT
- +11 SET FLAG=$PIECE($GET(^AUPNVMIC(LIEN,11)),U,9)
- +12 IF FLAG'="R"&(FLAG'="M")
- QUIT
- +13 SET MICRO(VSDTM,VIEN,LIEN)=VALUE_U_"9000010.25"_U_TIEN
- End DoDot:2
- End DoDot:1
- +14 QUIT
- +15 ;
- LBB(TMFRAME,RECENT,DATE,BQDFN,TAX,SEARCH,TREF) ;EP
- +1 IF $GET(TMFRAME)'=""
- Begin DoDot:1
- +2 IF TMFRAME'["-"
- QUIT
- +3 SET TMFRAME=$PIECE(TMFRAME,"-",2)
- End DoDot:1
- +4 SET BDATE=$$FMADD^XLFDT(DATE,-TMFRAME)
- SET EDATE=$$FMADD^XLFDT(DATE,TMFRAME)
- +5 SET TEMP=$NAME(^TMP("BQITEMP",UID))
- KILL @TEMP
- +6 SET TAX=$GET(TAX,"")
- SET RECENT=$GET(RECENT,0)
- +7 IF TAX'=""
- Begin DoDot:1
- +8 SET TREF=$NAME(^TMP("BQITAX",UID))
- +9 KILL @TREF
- +10 DO BLD^BQITUTL(TAX,TREF)
- End DoDot:1
- +11 ;
- +12 SET LIEN=""
- SET QFL=0
- SET RES=0_U_"No Test"
- SET CT=0
- +13 Begin DoDot:1
- +14 SET TIEN=""
- +15 FOR
- SET TIEN=$ORDER(@TREF@(TIEN))
- IF TIEN=""
- QUIT
- Begin DoDot:2
- +16 SET EDT=9999999-BDATE
- SET BDT=(9999999-EDATE)-.001
- +17 IF $PIECE($GET(^LAB(60,TIEN,0)),U,4)="MI"
- Begin DoDot:3
- +18 DO MIC(BQDFN,TIEN,EDT,BDT,.MICRO)
- +19 MERGE @TEMP=MICRO
- +20 KILL MICRO
- End DoDot:3
- QUIT
- +21 FOR
- SET BDT=$ORDER(^AUPNVLAB("AA",BQDFN,TIEN,BDT))
- IF BDT=""!(BDT>EDT)
- QUIT
- Begin DoDot:3
- +22 SET LIEN=""
- +23 FOR
- SET LIEN=$ORDER(^AUPNVLAB("AA",BQDFN,TIEN,BDT,LIEN))
- IF LIEN=""
- QUIT
- Begin DoDot:4
- +24 SET VALUE=$PIECE(^AUPNVLAB(LIEN,0),U,4)
- IF VALUE=""
- QUIT
- +25 SET VIEN=$PIECE(^AUPNVLAB(LIEN,0),U,3)
- IF VIEN=""
- QUIT
- +26 SET FLAG=$PIECE($GET(^AUPNVLAB(LIEN,11)),U,9)
- IF FLAG=""
- QUIT
- +27 IF FLAG'="R"&(FLAG'="M")
- QUIT
- +28 SET VSDTM=$$GET1^DIQ(9000010,VIEN_",",.01,"I")\1
- IF VSDTM=0
- QUIT
- +29 ;I $G(TMFRAME)'="",VSDTM<BDATE Q
- +30 ; quit if deleted flag
- +31 IF $PIECE($GET(^AUPNVSIT(VIEN,0)),U,11)=1
- QUIT
- +32 IF $PIECE($GET(^AUPNVLAB(LIEN,11)),U,9)="D"
- QUIT
- +33 SET @TEMP@(VSDTM,VIEN,LIEN)=VALUE_U_"9000010.09"_U_TIEN
- End DoDot:4
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +34 ;
- +35 SET VSDTM=""
- +36 FOR
- SET VSDTM=$ORDER(@TEMP@(VSDTM),-1)
- IF VSDTM=""
- QUIT
- Begin DoDot:1
- +37 SET VIEN=$ORDER(@TEMP@(VSDTM,""),-1)
- SET LIEN=""
- +38 FOR
- SET LIEN=$ORDER(@TEMP@(VSDTM,VIEN,LIEN),-1)
- IF LIEN=""!(QFL)
- QUIT
- Begin DoDot:2
- +39 SET VALUE=$PIECE(@TEMP@(VSDTM,VIEN,LIEN),U,1)
- SET OVALUE=VALUE
- +40 SET FILE=$PIECE(@TEMP@(VSDTM,VIEN,LIEN),U,2)
- +41 SET TIEN=$PIECE(@TEMP@(VSDTM,VIEN,LIEN),U,3)
- +42 KILL ROPER
- +43 SET RN=""
- +44 FOR
- SET RN=$ORDER(SEARCH(RN))
- IF RN=""
- QUIT
- Begin DoDot:3
- +45 SET OPER=$PIECE(SEARCH(RN),U,2)
- SET RESULT=$PIECE(SEARCH(RN),U,1)
- SET OPER2=$PIECE(SEARCH(RN),U,4)
- SET RES2=$PIECE(SEARCH(RN),U,3)
- +46 DO RCHK
- End DoDot:3
- IF QFL
- QUIT
- End DoDot:2
- End DoDot:1
- IF QFL
- QUIT
- +47 KILL @TEMP
- +48 QUIT RES