BTPWPHIS.m

BTPWPHIS ;VNGT/HS/ALA-CMET Event History ; 01 Sep 2009  5:01 PM

 ;;1.0;CARE MANAGEMENT EVENT TRACKING;;Feb 07, 2011

 ;

 ;

EN(DATA,CMIEN) ; EP -- BTPW GET EVENT HISTORY

 NEW UID,II

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

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

 K @DATA

 ;

 S II=0

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

 S @DATA@(II)="I00010CMET_IEN^T00030EVENT_NAME^D00015EVENT_DATE^T00005STATE"_$C(30)

 I $P(^BTPWP(CMIEN,0),U,11)'="" D REC

 ;

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

 S II=II+1,@DATA@(II)=$C(31)

 Q

 ;

REC ;EP - Recursive check

 S PRIEN=$P(^BTPWP(CMIEN,0),U,11) I PRIEN="" Q

 S NAME=$$GET1^DIQ(90620,PRIEN_",",.01,"E"),EVDT=$$GET1^DIQ(90620,PRIEN_",",.03,"I")

 S STATE=$$GET1^DIQ(90620,PRIEN_",",1.01,"E")

 S II=II+1,@DATA@(II)=PRIEN_U_NAME_U_$$FMTE^BQIUL1(EVDT)_U_STATE_$C(30)

 S CMIEN=PRIEN

 G REC

BTPWPHIS  ;VNGT/HS/ALA-CMET Event History ; 01 Sep 2009  5:01 PM

 +1       ;;1.0;CARE MANAGEMENT EVENT TRACKING;;Feb 07, 2011

 +2       ;

 +3       ;

EN(DATA,CMIEN) ; EP -- BTPW GET EVENT HISTORY

 +1        NEW UID,II

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

 +3        SET DATA=$NAME(^TMP("BTPWPHIS",UID))

 +4        KILL @DATA

 +5       ;

 +6        SET II=0

 +7       ; SAC 2006 2.2.3.3.2

           NEW $ESTACK,$ETRAP

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

 +8        SET @DATA@(II)="I00010CMET_IEN^T00030EVENT_NAME^D00015EVENT_DATE^T00005STATE"_$CHAR(30)

 +9        IF $PIECE(^BTPWP(CMIEN,0),U,11)'=""

               DO REC

 +10      ;

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        SET II=II+1

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

 +6        QUIT 

 +7       ;

REC       ;EP - Recursive check

 +1        SET PRIEN=$PIECE(^BTPWP(CMIEN,0),U,11)

           IF PRIEN=""

               QUIT 

 +2        SET NAME=$$GET1^DIQ(90620,PRIEN_",",.01,"E")

           SET EVDT=$$GET1^DIQ(90620,PRIEN_",",.03,"I")

 +3        SET STATE=$$GET1^DIQ(90620,PRIEN_",",1.01,"E")

 +4        SET II=II+1

           SET @DATA@(II)=PRIEN_U_NAME_U_$$FMTE^BQIUL1(EVDT)_U_STATE_$CHAR(30)

 +5        SET CMIEN=PRIEN

 +6        GOTO REC