- BQIPTEXM ;PRXM/HC/ALA-Patient Exams ; 26 Mar 2007 2:57 PM
- ;;2.1;ICARE MANAGEMENT SYSTEM;;Feb 07, 2011
- ;
- Q
- ;
- EXM(DATA,DFN,DRANGE) ; EP -- BQI PATIENT EXAMS
- ;
- ;Description - all the exams that a patient has
- ;
- ;Input
- ; DFN - Patient internal entry number
- ;
- NEW UID,II,IEN,EXAM,VISIT,VSDTM,RESULT,ORPHY,ENPHY,COMMENT
- S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
- S DATA=$NA(^TMP("BQIPTEXM",UID))
- K @DATA
- ;
- S II=0
- NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIPTEXM D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
- ;
- S DRANGE=$$DATE^BQIUL1($G(DRANGE))
- S @DATA@(II)="I00010EXAM_IEN^I00010VISIT_IEN^D00030VISIT_DATETIME^T00030EXAM^T00020RESULT^T00035ENC_PROV^T00245COMMENTS"_$C(30)
- S IEN=""
- F S IEN=$O(^AUPNVXAM("AC",DFN,IEN),-1) Q:IEN="" D
- . S EXAM=$$GET1^DIQ(9000010.13,IEN_",",.01,"E") I EXAM="" Q
- . S VISIT=$$GET1^DIQ(9000010.13,IEN_",",.03,"I") I VISIT="" Q
- . S VSDTM=$$GET1^DIQ(9000010,VISIT_",",.01,"I") I VSDTM=0 Q
- . I DRANGE'="",(VSDTM\1<DRANGE) Q
- . S RESULT=$$GET1^DIQ(9000010.13,IEN_",",.04,"E")
- . ;S ORPHY=$$GET1^DIQ(9000010.13,IEN_",",1202,"E")
- . S ENPHY=$$GET1^DIQ(9000010.13,IEN_",",1204,"E")
- . S COMMENT=$$GET1^DIQ(9000010.13,IEN_",",81101,"E")
- . S II=II+1,@DATA@(II)=IEN_U_VISIT_U_$$FMTE^BQIUL1(VSDTM)_U_EXAM_U_RESULT_U_ENPHY_U_COMMENT_$C(30)
- ;
- ; Check for refusals
- D REF
- S II=II+1,@DATA@(II)=$C(31)
- Q
- ;
- ERR ;
- D ^%ZTER
- NEW Y,ERRDTM
- S Y=$$NOW^XLFDT() X ^DD("DD") S ERRDTM=Y
- S BMXSEC="Recording that an error occurred at "_ERRDTM
- I $D(II),$D(DATA) S II=II+1,@DATA@(II)=$C(31)
- Q
- ;
- REF ; Check for refusals
- NEW EXN,RVDT,REVDT,RFIEN,VISIT,EXAM,RESULT
- S EXN=""
- F S EXN=$O(^AUPNPREF("AA",DFN,9999999.15,EXN)) Q:EXN="" D
- . S RVDT=""
- . F S RVDT=$O(^AUPNPREF("AA",DFN,9999999.15,EXN,RVDT)) Q:RVDT="" D
- .. ; Reverse the reverse date
- .. S REVDT=9999999-RVDT
- .. I DRANGE'="",(REVDT\1)<DRANGE Q
- .. S RFIEN=""
- .. F S RFIEN=$O(^AUPNPREF("AA",DFN,9999999.15,EXN,RVDT,RFIEN)) Q:RFIEN="" D
- ... S EXAM=$$GET1^DIQ(9999999.15,EXN_",",.01,"E")
- ... S RESULT=$$GET1^DIQ(9000022,RFIEN_",",.07,"E")
- ... S ENPHY=$$GET1^DIQ(9000022,RFIEN_",",1204,"E")
- ... S COMMENT=$$GET1^DIQ(9000022,RFIEN_",",1101,"E")
- ... S VISIT=""
- ... S II=II+1,@DATA@(II)=U_VISIT_U_$$FMTE^BQIUL1(REVDT)_U_EXAM_U_RESULT_U_ENPHY_U_COMMENT_$C(30)
- Q
- BQIPTEXM ;PRXM/HC/ALA-Patient Exams ; 26 Mar 2007 2:57 PM
- +1 ;;2.1;ICARE MANAGEMENT SYSTEM;;Feb 07, 2011
- +2 ;
- +3 QUIT
- +4 ;
- EXM(DATA,DFN,DRANGE) ; EP -- BQI PATIENT EXAMS
- +1 ;
- +2 ;Description - all the exams that a patient has
- +3 ;
- +4 ;Input
- +5 ; DFN - Patient internal entry number
- +6 ;
- +7 NEW UID,II,IEN,EXAM,VISIT,VSDTM,RESULT,ORPHY,ENPHY,COMMENT
- +8 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
- +9 SET DATA=$NAME(^TMP("BQIPTEXM",UID))
- +10 KILL @DATA
- +11 ;
- +12 SET II=0
- +13 ; SAC 2006 2.2.3.3.2
- NEW $ESTACK,$ETRAP
- SET $ETRAP="D ERR^BQIPTEXM D UNWIND^%ZTER"
- +14 ;
- +15 SET DRANGE=$$DATE^BQIUL1($GET(DRANGE))
- +16 SET @DATA@(II)="I00010EXAM_IEN^I00010VISIT_IEN^D00030VISIT_DATETIME^T00030EXAM^T00020RESULT^T00035ENC_PROV^T00245COMMENTS"_$CHAR(30)
- +17 SET IEN=""
- +18 FOR
- SET IEN=$ORDER(^AUPNVXAM("AC",DFN,IEN),-1)
- IF IEN=""
- QUIT
- Begin DoDot:1
- +19 SET EXAM=$$GET1^DIQ(9000010.13,IEN_",",.01,"E")
- IF EXAM=""
- QUIT
- +20 SET VISIT=$$GET1^DIQ(9000010.13,IEN_",",.03,"I")
- IF VISIT=""
- QUIT
- +21 SET VSDTM=$$GET1^DIQ(9000010,VISIT_",",.01,"I")
- IF VSDTM=0
- QUIT
- +22 IF DRANGE'=""
- IF (VSDTM\1<DRANGE)
- QUIT
- +23 SET RESULT=$$GET1^DIQ(9000010.13,IEN_",",.04,"E")
- +24 ;S ORPHY=$$GET1^DIQ(9000010.13,IEN_",",1202,"E")
- +25 SET ENPHY=$$GET1^DIQ(9000010.13,IEN_",",1204,"E")
- +26 SET COMMENT=$$GET1^DIQ(9000010.13,IEN_",",81101,"E")
- +27 SET II=II+1
- SET @DATA@(II)=IEN_U_VISIT_U_$$FMTE^BQIUL1(VSDTM)_U_EXAM_U_RESULT_U_ENPHY_U_COMMENT_$CHAR(30)
- End DoDot:1
- +28 ;
- +29 ; Check for refusals
- +30 DO REF
- +31 SET II=II+1
- SET @DATA@(II)=$CHAR(31)
- +32 QUIT
- +33 ;
- ERR ;
- +1 DO ^%ZTER
- +2 NEW Y,ERRDTM
- +3 SET Y=$$NOW^XLFDT()
- XECUTE ^DD("DD")
- SET ERRDTM=Y
- +4 SET BMXSEC="Recording that an error occurred at "_ERRDTM
- +5 IF $DATA(II)
- IF $DATA(DATA)
- SET II=II+1
- SET @DATA@(II)=$CHAR(31)
- +6 QUIT
- +7 ;
- REF ; Check for refusals
- +1 NEW EXN,RVDT,REVDT,RFIEN,VISIT,EXAM,RESULT
- +2 SET EXN=""
- +3 FOR
- SET EXN=$ORDER(^AUPNPREF("AA",DFN,9999999.15,EXN))
- IF EXN=""
- QUIT
- Begin DoDot:1
- +4 SET RVDT=""
- +5 FOR
- SET RVDT=$ORDER(^AUPNPREF("AA",DFN,9999999.15,EXN,RVDT))
- IF RVDT=""
- QUIT
- Begin DoDot:2
- +6 ; Reverse the reverse date
- +7 SET REVDT=9999999-RVDT
- +8 IF DRANGE'=""
- IF (REVDT\1)<DRANGE
- QUIT
- +9 SET RFIEN=""
- +10 FOR
- SET RFIEN=$ORDER(^AUPNPREF("AA",DFN,9999999.15,EXN,RVDT,RFIEN))
- IF RFIEN=""
- QUIT
- Begin DoDot:3
- +11 SET EXAM=$$GET1^DIQ(9999999.15,EXN_",",.01,"E")
- +12 SET RESULT=$$GET1^DIQ(9000022,RFIEN_",",.07,"E")
- +13 SET ENPHY=$$GET1^DIQ(9000022,RFIEN_",",1204,"E")
- +14 SET COMMENT=$$GET1^DIQ(9000022,RFIEN_",",1101,"E")
- +15 SET VISIT=""
- +16 SET II=II+1
- SET @DATA@(II)=U_VISIT_U_$$FMTE^BQIUL1(REVDT)_U_EXAM_U_RESULT_U_ENPHY_U_COMMENT_$CHAR(30)
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +17 QUIT
