BQIPTEXM.m

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