BQIPTPOV.m

BQIPTPOV ;GDHS/HCD/ALA-Patient POVs ; 02 Nov 2016  2:28 PM

 ;;2.6;ICARE MANAGEMENT SYSTEM;;Jul 07, 2017;Build 72

 ;;

 ;

 Q

 ;

POV(DATA,DFN,DRANGE) ; EP -- BQI PATIENT POVS

 ;

 ;Description - all the POVs that a patient has

 ;

 ;Input

 ;  DFN - Patient internal entry number

 ;  DRANGE - Date range as a relative date ie. T-6M

 ;

 NEW UID,II,IEN,TIEN,TNAME,VISIT,VSDTM,VALUE,TCODE,TFREV,TPRSC,TENCPRV,TNARR

 S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)

 S DATA=$NA(^TMP("BQIPTPOV",UID))

 K @DATA

 ;

 S II=0

 NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIPTPOV D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2

 ;

 S DRANGE=$$DATE^BQIUL1($G(DRANGE))

 S HEADR="I00010POV_IEN^I00010VISIT_IEN^D00030VISIT_DATETIME^T00015TYPE_CODE^T00030TYPE_DESC^T00011FIRSTREVISIT^"

 S HEADR=HEADR_"T00009PRIMSEC^T00030ENCOUNTERPROV^T00080PROV_NARR"

 S @DATA@(II)=HEADR_$C(30)

 S IEN=""

 F  S IEN=$O(^AUPNVPOV("AC",DFN,IEN),-1) Q:IEN=""  D

 . S TIEN=$$GET1^DIQ(9000010.07,IEN_",",.01,"I") I TIEN="" Q

 . S VISIT=$$GET1^DIQ(9000010.07,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 TCODE=$$CODEC^ICDCODE(TIEN,80)

 . S TNAME=$$VST^ICDCODE(TIEN,"",80)

 . S TFREV=$$GET1^DIQ(9000010.07,IEN_",",.08,"E")

 . S TPRSC=$$GET1^DIQ(9000010.07,IEN_",",.12,"E")

 . S TENCPRV=$$GET1^DIQ(9000010.07,IEN_",",1204,"E")

 . S TNARR=$$GET1^DIQ(9000010.07,IEN_",",.04,"E")

 . S II=II+1,@DATA@(II)=IEN_U_VISIT_U_$$FMTE^BQIUL1(VSDTM)_U_TCODE_U_TNAME_U_TFREV_U_TPRSC_U_TENCPRV_U_TNARR_$C(30)

 ;

DONE ;

 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

BQIPTPOV  ;GDHS/HCD/ALA-Patient POVs ; 02 Nov 2016  2:28 PM

 +1       ;;2.6;ICARE MANAGEMENT SYSTEM;;Jul 07, 2017;Build 72

 +2       ;;

 +3       ;

 +4        QUIT 

 +5       ;

POV(DATA,DFN,DRANGE) ; EP -- BQI PATIENT POVS

 +1       ;

 +2       ;Description - all the POVs that a patient has

 +3       ;

 +4       ;Input

 +5       ;  DFN - Patient internal entry number

 +6       ;  DRANGE - Date range as a relative date ie. T-6M

 +7       ;

 +8        NEW UID,II,IEN,TIEN,TNAME,VISIT,VSDTM,VALUE,TCODE,TFREV,TPRSC,TENCPRV,TNARR

 +9        SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)

 +10       SET DATA=$NAME(^TMP("BQIPTPOV",UID))

 +11       KILL @DATA

 +12      ;

 +13       SET II=0

 +14      ; SAC 2006 2.2.3.3.2

           NEW $ESTACK,$ETRAP

           SET $ETRAP="D ERR^BQIPTPOV D UNWIND^%ZTER"

 +15      ;

 +16       SET DRANGE=$$DATE^BQIUL1($GET(DRANGE))

 +17       SET HEADR="I00010POV_IEN^I00010VISIT_IEN^D00030VISIT_DATETIME^T00015TYPE_CODE^T00030TYPE_DESC^T00011FIRSTREVISIT^"

 +18       SET HEADR=HEADR_"T00009PRIMSEC^T00030ENCOUNTERPROV^T00080PROV_NARR"

 +19       SET @DATA@(II)=HEADR_$CHAR(30)

 +20       SET IEN=""

 +21       FOR 

               SET IEN=$ORDER(^AUPNVPOV("AC",DFN,IEN),-1)

               IF IEN=""

                   QUIT 

               Begin DoDot:1

 +22               SET TIEN=$$GET1^DIQ(9000010.07,IEN_",",.01,"I")

                   IF TIEN=""

                       QUIT 

 +23               SET VISIT=$$GET1^DIQ(9000010.07,IEN_",",.03,"I")

                   IF VISIT=""

                       QUIT 

 +24               SET VSDTM=$$GET1^DIQ(9000010,VISIT_",",.01,"I")

                   IF VSDTM=0

                       QUIT 

 +25               IF DRANGE'=""

                       IF (VSDTM\1<DRANGE)

                           QUIT 

 +26               SET TCODE=$$CODEC^ICDCODE(TIEN,80)

 +27               SET TNAME=$$VST^ICDCODE(TIEN,"",80)

 +28               SET TFREV=$$GET1^DIQ(9000010.07,IEN_",",.08,"E")

 +29               SET TPRSC=$$GET1^DIQ(9000010.07,IEN_",",.12,"E")

 +30               SET TENCPRV=$$GET1^DIQ(9000010.07,IEN_",",1204,"E")

 +31               SET TNARR=$$GET1^DIQ(9000010.07,IEN_",",.04,"E")

 +32               SET II=II+1

                   SET @DATA@(II)=IEN_U_VISIT_U_$$FMTE^BQIUL1(VSDTM)_U_TCODE_U_TNAME_U_TFREV_U_TPRSC_U_TENCPRV_U_TNARR_$CHAR(30)

               End DoDot:1

 +33      ;

DONE      ;

 +1        SET II=II+1

           SET @DATA@(II)=$CHAR(31)

 +2        QUIT 

 +3       ;

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