- BQITDLAB ;GDIT/HS/ALA-Labs ; 20 Oct 2014 3:13 PM
- ;;2.6;ICARE MANAGEMENT SYSTEM;;Jul 07, 2017;Build 72
- ;
- LBP(TMFRAME,RECENT,BQDFN,TAX,SEARCH,TREF,ARRAY) ;EP
- ; Check for a lab test results by patient
- ;
- ; 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)
- ; ARRAY - Where to place data
- ;
- 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),ARRAY(0)=0_U_"No Test"
- I TAX'="" D
- . S TREF=$NA(^TMP("BQITAX",UID))
- . K @TREF
- . D BLD^BQITUTL(TAX,TREF)
- ;
- S LIEN="",QFL=0,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
- . S VIEN=$O(@TEMP@(VSDTM,""),-1)
- . S LIEN=$O(@TEMP@(VSDTM,VIEN,""),-1)
- . 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
- S ARRAY(0)=CT
- Q
- ;
- 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 CT=CT+1,ARRAY(CT)=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 CT=CT+1,ARRAY(CT)=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 CT=CT+1,ARRAY(CT)=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 CT=CT+1,ARRAY(CT)=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 CT=CT+1,ARRAY(CT)=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,ARRAY) ;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,ARRAY(0)=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)
- . S LIEN=$O(@TEMP@(VSDTM,VIEN,""),-1)
- . 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
- S ARRAY(0)=CT
- Q
- ;
- LPOP(TMFRAME,RECENT,TAX,SEARCH,TREF,ARRAY) ;EP
- I $G(TMFRAME)'="" D
- . I TMFRAME'["-" Q
- . S TMFRAME=$P(TMFRAME,"-",2)
- S FDT=$$DATE^BQIUL1(TMFRAME),TDT=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,ARRAY(0)=0_U_"No Test",CT=0
- D
- . S TIEN=""
- . F S TIEN=$O(@TREF@(TIEN)) Q:TIEN="" D
- .. S IEN=""
- .. F S IEN=$O(^AUPNVLAB("B",TIEN,IEN)) Q:IEN="" D
- ... I $G(^AUPNVLAB(IEN,0))="" Q
- ... S DFN=$P($G(^AUPNVLAB(IEN,0)),U,2),VIS=$P(^AUPNVLAB(IEN,0),U,3) I VIS="" Q
- ... I $G(^AUPNVSIT(VIS,0))="" Q
- ... Q:"DXCTI"[$P(^AUPNVSIT(VIS,0),U,7)
- ... S VSDTM=$P(^AUPNVSIT(VIS,0),U,1)\1
- ... I FDT'="",VSDTM<FDT!(VSDTM>TDT) Q
- ... S VALUE=$P($G(^AUPNVLAB(IEN,0)),U,4)
- ... I $P($G(^AUPNVSIT(VIEN,0)),U,11)=1 Q
- ... I $P($G(^AUPNVLAB(LIEN,11)),U,9)="D" Q
- ... S FLAG=$P($G(^AUPNVLAB(LIEN,11)),U,9) I FLAG="" Q
- ... I FLAG'="R"&(FLAG'="M") 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)
- . S LIEN=$O(@TEMP@(VSDTM,VIEN,""),-1)
- . 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
- S ARRAY(0)=CT
- Q
- BQITDLAB ;GDIT/HS/ALA-Labs ; 20 Oct 2014 3:13 PM
- +1 ;;2.6;ICARE MANAGEMENT SYSTEM;;Jul 07, 2017;Build 72
- +2 ;
- LBP(TMFRAME,RECENT,BQDFN,TAX,SEARCH,TREF,ARRAY) ;EP
- +1 ; Check for a lab test results by patient
- +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 ; ARRAY - Where to place data
- +15 ;
- +16 NEW TEMP,EDATE,BDATE,LIEN,QFL,RES,CT,VALUE,VIEN,VSDTM
- +17 SET BDATE=$$DATE^BQIUL1(TMFRAME)
- SET EDATE=DT
- +18 SET TEMP=$NAME(^TMP("BQITEMP",UID))
- KILL @TEMP
- +19 SET TAX=$GET(TAX,"")
- SET RECENT=$GET(RECENT,0)
- SET ARRAY(0)=0_U_"No Test"
- +20 IF TAX'=""
- Begin DoDot:1
- +21 SET TREF=$NAME(^TMP("BQITAX",UID))
- +22 KILL @TREF
- +23 DO BLD^BQITUTL(TAX,TREF)
- End DoDot:1
- +24 ;
- +25 SET LIEN=""
- SET QFL=0
- SET CT=0
- +26 IF $GET(TMFRAME)'=""
- Begin DoDot:1
- +27 SET TIEN=""
- +28 FOR
- SET TIEN=$ORDER(@TREF@(TIEN))
- IF TIEN=""
- QUIT
- Begin DoDot:2
- +29 SET EDT=9999999-BDATE
- SET BDT=(9999999-EDATE)-.001
- +30 IF $PIECE($GET(^LAB(60,TIEN,0)),U,4)="MI"
- Begin DoDot:3
- +31 DO MIC(BQDFN,TIEN,EDT,BDT,.MICRO)
- +32 MERGE @TEMP=MICRO
- +33 KILL MICRO
- End DoDot:3
- QUIT
- +34 FOR
- SET BDT=$ORDER(^AUPNVLAB("AA",BQDFN,TIEN,BDT))
- IF BDT=""!(BDT>EDT)
- QUIT
- Begin DoDot:3
- +35 SET LIEN=""
- +36 FOR
- SET LIEN=$ORDER(^AUPNVLAB("AA",BQDFN,TIEN,BDT,LIEN))
- IF LIEN=""
- QUIT
- Begin DoDot:4
- +37 SET VALUE=$PIECE(^AUPNVLAB(LIEN,0),U,4)
- IF VALUE=""
- QUIT
- +38 SET VIEN=$PIECE(^AUPNVLAB(LIEN,0),U,3)
- IF VIEN=""
- QUIT
- +39 SET FLAG=$PIECE($GET(^AUPNVLAB(LIEN,11)),U,9)
- IF FLAG=""
- QUIT
- +40 IF FLAG'="R"&(FLAG'="M")
- QUIT
- +41 SET VSDTM=$$GET1^DIQ(9000010,VIEN_",",.01,"I")\1
- IF VSDTM=0
- QUIT
- +42 ;I $G(TMFRAME)'="",VSDTM<BDATE Q
- +43 ; quit if deleted flag
- +44 IF $PIECE($GET(^AUPNVSIT(VIEN,0)),U,11)=1
- QUIT
- +45 IF $PIECE($GET(^AUPNVLAB(LIEN,11)),U,9)="D"
- QUIT
- +46 SET @TEMP@(VSDTM,VIEN,LIEN)=VALUE_U_"9000010.09"_U_TIEN
- End DoDot:4
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +47 ;
- +48 IF $GET(TMFRAME)=""
- Begin DoDot:1
- +49 SET LIEN=""
- +50 FOR
- SET LIEN=$ORDER(^AUPNVLAB("AC",BQDFN,LIEN),-1)
- IF LIEN=""
- QUIT
- Begin DoDot:2
- +51 SET TIEN=$PIECE($GET(^AUPNVLAB(LIEN,0)),U,1)
- IF TIEN=""
- QUIT
- +52 IF '$DATA(@TREF@(TIEN))
- QUIT
- +53 SET VALUE=$PIECE(^AUPNVLAB(LIEN,0),U,4)
- IF VALUE=""
- QUIT
- +54 SET VIEN=$PIECE(^AUPNVLAB(LIEN,0),U,3)
- IF VIEN=""
- QUIT
- +55 SET VSDTM=$$GET1^DIQ(9000010,VIEN_",",.01,"I")\1
- IF VSDTM=0
- QUIT
- +56 ;I $G(TMFRAME)'="",VSDTM<BDATE Q
- +57 ; quit if deleted flag
- +58 IF $PIECE($GET(^AUPNVSIT(VIEN,0)),U,11)=1
- QUIT
- +59 IF $PIECE($GET(^AUPNVLAB(LIEN,11)),U,9)="D"
- QUIT
- +60 SET @TEMP@(VSDTM,VIEN,LIEN)=VALUE_U_"9000010.09"_U_TIEN
- End DoDot:2
- +61 FOR
- SET LIEN=$ORDER(^AUPNVMIC("AC",BQDFN,LIEN),-1)
- IF LIEN=""
- QUIT
- Begin DoDot:2
- +62 SET TIEN=$PIECE($GET(^AUPNVMIC(LIEN,0)),U,1)
- IF TIEN=""
- QUIT
- +63 IF '$DATA(@TREF@(TIEN))
- QUIT
- +64 SET VALUE=$PIECE(^AUPNVMIC(LIEN,0),U,7)
- IF VALUE=""
- QUIT
- +65 SET VIEN=$PIECE(^AUPNVMIC(LIEN,0),U,3)
- IF VIEN=""
- QUIT
- +66 SET VSDTM=$$GET1^DIQ(9000010,VIEN_",",.01,"I")\1
- IF VSDTM=0
- QUIT
- +67 ; quit if deleted flag
- +68 IF $PIECE($GET(^AUPNVSIT(VIEN,0)),U,11)=1
- QUIT
- +69 SET FLAG=$PIECE($GET(^AUPNVMIC(LIEN,11)),U,9)
- +70 IF FLAG'="R"&(FLAG'="M")
- QUIT
- +71 SET @TEMP@(VSDTM,VIEN,LIEN)=VALUE_U_"9000010.25"_U_TIEN
- End DoDot:2
- End DoDot:1
- +72 ;
- +73 SET VSDTM=""
- +74 FOR
- SET VSDTM=$ORDER(@TEMP@(VSDTM),-1)
- IF VSDTM=""
- QUIT
- Begin DoDot:1
- +75 SET VIEN=$ORDER(@TEMP@(VSDTM,""),-1)
- +76 SET LIEN=$ORDER(@TEMP@(VSDTM,VIEN,""),-1)
- +77 SET VALUE=$PIECE(@TEMP@(VSDTM,VIEN,LIEN),U,1)
- SET OVALUE=VALUE
- +78 SET FILE=$PIECE(@TEMP@(VSDTM,VIEN,LIEN),U,2)
- +79 SET TIEN=$PIECE(@TEMP@(VSDTM,VIEN,LIEN),U,3)
- +80 KILL ROPER
- +81 SET RN=""
- +82 FOR
- SET RN=$ORDER(SEARCH(RN))
- IF RN=""
- QUIT
- Begin DoDot:2
- +83 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)
- +84 DO RCHK
- End DoDot:2
- IF QFL
- QUIT
- End DoDot:1
- +85 KILL @TEMP
- +86 SET ARRAY(0)=CT
- +87 QUIT
- +88 ;
- 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 CT=CT+1
- SET ARRAY(CT)=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 CT=CT+1
- SET ARRAY(CT)=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 CT=CT+1
- SET ARRAY(CT)=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 CT=CT+1
- SET ARRAY(CT)=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 CT=CT+1
- SET ARRAY(CT)=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,ARRAY) ;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 ARRAY(0)=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)
- +38 SET LIEN=$ORDER(@TEMP@(VSDTM,VIEN,""),-1)
- +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:2
- +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:2
- IF QFL
- QUIT
- End DoDot:1
- IF QFL
- QUIT
- +47 KILL @TEMP
- +48 SET ARRAY(0)=CT
- +49 QUIT
- +50 ;
- LPOP(TMFRAME,RECENT,TAX,SEARCH,TREF,ARRAY) ;EP
- +1 IF $GET(TMFRAME)'=""
- Begin DoDot:1
- +2 IF TMFRAME'["-"
- QUIT
- +3 SET TMFRAME=$PIECE(TMFRAME,"-",2)
- End DoDot:1
- +4 SET FDT=$$DATE^BQIUL1(TMFRAME)
- SET TDT=DT
- +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 ARRAY(0)=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 IEN=""
- +17 FOR
- SET IEN=$ORDER(^AUPNVLAB("B",TIEN,IEN))
- IF IEN=""
- QUIT
- Begin DoDot:3
- +18 IF $GET(^AUPNVLAB(IEN,0))=""
- QUIT
- +19 SET DFN=$PIECE($GET(^AUPNVLAB(IEN,0)),U,2)
- SET VIS=$PIECE(^AUPNVLAB(IEN,0),U,3)
- IF VIS=""
- QUIT
- +20 IF $GET(^AUPNVSIT(VIS,0))=""
- QUIT
- +21 IF "DXCTI"[$PIECE(^AUPNVSIT(VIS,0),U,7)
- QUIT
- +22 SET VSDTM=$PIECE(^AUPNVSIT(VIS,0),U,1)\1
- +23 IF FDT'=""
- IF VSDTM<FDT!(VSDTM>TDT)
- QUIT
- +24 SET VALUE=$PIECE($GET(^AUPNVLAB(IEN,0)),U,4)
- +25 IF $PIECE($GET(^AUPNVSIT(VIEN,0)),U,11)=1
- QUIT
- +26 IF $PIECE($GET(^AUPNVLAB(LIEN,11)),U,9)="D"
- QUIT
- +27 SET FLAG=$PIECE($GET(^AUPNVLAB(LIEN,11)),U,9)
- IF FLAG=""
- QUIT
- +28 IF FLAG'="R"&(FLAG'="M")
- QUIT
- +29 SET @TEMP@(VSDTM,VIEN,LIEN)=VALUE_U_"9000010.09"_U_TIEN
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +30 ;
- +31 SET VSDTM=""
- +32 FOR
- SET VSDTM=$ORDER(@TEMP@(VSDTM),-1)
- IF VSDTM=""
- QUIT
- Begin DoDot:1
- +33 SET VIEN=$ORDER(@TEMP@(VSDTM,""),-1)
- +34 SET LIEN=$ORDER(@TEMP@(VSDTM,VIEN,""),-1)
- +35 SET VALUE=$PIECE(@TEMP@(VSDTM,VIEN,LIEN),U,1)
- SET OVALUE=VALUE
- +36 SET FILE=$PIECE(@TEMP@(VSDTM,VIEN,LIEN),U,2)
- +37 SET TIEN=$PIECE(@TEMP@(VSDTM,VIEN,LIEN),U,3)
- +38 KILL ROPER
- +39 SET RN=""
- +40 FOR
- SET RN=$ORDER(SEARCH(RN))
- IF RN=""
- QUIT
- Begin DoDot:2
- +41 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)
- +42 DO RCHK
- End DoDot:2
- IF QFL
- QUIT
- End DoDot:1
- IF QFL
- QUIT
- +43 KILL @TEMP
- +44 SET ARRAY(0)=CT
- +45 QUIT