BTPWPCLO ;VNGT/HS/ALA-Close Event ; 20 Oct 2009 3:46 PM
;;1.0;CARE MANAGEMENT EVENT TRACKING;**1**;Feb 07, 2011;Build 37
;
;
VAL(DATA,CLIST) ;EP -- BTPW VALIDATE CLOSE EVENT
; Input
; CLIST - List of tracked items that are being closed
; Output
; RESULT - 1 is okay to proceed, -1 cannot proceed
; MSG - Message to display for either a 'W' or an 'O'
; HANDLER - 'W' is a warning message to be displayed, 'O' is an override
; CMET_IEN - Record that passed or failed.
NEW UID,II,BQI,LIST,BN,ANSWR,MESG,RES,MSG,VAL,ANSWF,ANSWN,CMIEN,HNDLR
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("BTPWPCLO",UID))
K @DATA
S II=0,MSG=""
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BTPWPCLO D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
;
S @DATA@(II)="I00010RESULT^T00100MSG^T00001HANDLER^I00010CMET_IEN"_$C(30)
;
I $D(CLIST)>1 D
. S LIST="",BN=""
. F S BN=$O(CLIST(BN)) Q:BN="" S LIST=LIST_CLIST(BN)
. K CLIST S CLIST=LIST
I $G(CLIST)'="" D
. F BQI=1:1 S CMIEN=$P(CLIST,$C(28),BQI) Q:CMIEN="" D
.. S ANSWR=$$FND(CMIEN),MESG="",MSG="",HNDLR="" K VAL
.. S RES=$P(ANSWR,U,1),MSG=$P(ANSWR,U,2),VAL(RES)=$G(VAL(RES))_MSG_"; "
.. S ANSWF=$$FOL(CMIEN)
.. S RES=$P(ANSWF,U,1),MSG=$P(ANSWF,U,2),VAL(RES)=$G(VAL(RES))_MSG_"; "
.. S ANSWN=$$NOT(CMIEN)
.. S RES=$P(ANSWN,U,1),MSG=$P(ANSWN,U,2),VAL(RES)=$G(VAL(RES))_MSG_"; "
.. S RES=$O(VAL(""))
.. I RES=-1 S MESG=$$TKO^BQIUL1(VAL(RES),"; "),HNDLR="O"
.. S II=II+1,@DATA@(II)=RES_"^"_$G(MESG)_U_$G(HNDLR)_U_$G(CMIEN)_$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
;
FND(CMIEN) ;EP - Findings complete?
NEW FN,FNDATA,FND
S (FN,FND)=0 F S FN=$O(^BTPWP(CMIEN,10,FN)) Q:'FN D Q:FND
. I $$GET1^DIQ(90620.01,FN_","_CMIEN_",",".01","I")="" Q ;Bad Entry
. I $$GET1^DIQ(90620.01,FN_","_CMIEN_",",".08","I")="Y" Q ;Entered-in-Error
. S FND=1
I FND=0 Q "-1"_U_"No findings found"
Q "1^"
;
FOL(CMIEN) ;EP - Followup complete?
NEW FN,FOL,FNDATA
;
;First check if follow-up is needed
S FN=$$GET1^DIQ(90620,CMIEN_",",1.11,"I") I FN="N" Q "1^"
S (FN,FOL)=0 F S FN=$O(^BTPWP(CMIEN,12,FN)) Q:'FN D Q:FOL
. I $$GET1^DIQ(90620.012,FN_","_CMIEN_",",".01","I")="" Q ;Bad Entry
. I $$GET1^DIQ(90620.012,FN_","_CMIEN_",",".07","I")="Y" Q ;Entered-in-Error
. S FOL=1
I FOL=0 Q "-1"_U_"No followup found"
Q "1^"
;
NOT(CMIEN) ;EP - Notification complete?
NEW FN,NOT,FNDATA
S (FN,NOT)=0 F S FN=$O(^BTPWP(CMIEN,11,FN)) Q:'FN D Q:NOT
. I $$GET1^DIQ(90620.01,FN_","_CMIEN_",",".01","I")="" Q ;Bad Entry
. I $$GET1^DIQ(90620.01,FN_","_CMIEN_",",".09","I")="Y" Q ;Entered-in-Error
. S NOT=1
I NOT=0 Q "-1"_U_"No Notifications found"
Q "1^"
BTPWPCLO ;VNGT/HS/ALA-Close Event ; 20 Oct 2009 3:46 PM
+1 ;;1.0;CARE MANAGEMENT EVENT TRACKING;**1**;Feb 07, 2011;Build 37
+2 ;
+3 ;
VAL(DATA,CLIST) ;EP -- BTPW VALIDATE CLOSE EVENT
+1 ; Input
+2 ; CLIST - List of tracked items that are being closed
+3 ; Output
+4 ; RESULT - 1 is okay to proceed, -1 cannot proceed
+5 ; MSG - Message to display for either a 'W' or an 'O'
+6 ; HANDLER - 'W' is a warning message to be displayed, 'O' is an override
+7 ; CMET_IEN - Record that passed or failed.
+8 NEW UID,II,BQI,LIST,BN,ANSWR,MESG,RES,MSG,VAL,ANSWF,ANSWN,CMIEN,HNDLR
+9 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+10 SET DATA=$NAME(^TMP("BTPWPCLO",UID))
+11 KILL @DATA
+12 SET II=0
SET MSG=""
+13 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BTPWPCLO D UNWIND^%ZTER"
+14 ;
+15 SET @DATA@(II)="I00010RESULT^T00100MSG^T00001HANDLER^I00010CMET_IEN"_$CHAR(30)
+16 ;
+17 IF $DATA(CLIST)>1
Begin DoDot:1
+18 SET LIST=""
SET BN=""
+19 FOR
SET BN=$ORDER(CLIST(BN))
IF BN=""
QUIT
SET LIST=LIST_CLIST(BN)
+20 KILL CLIST
SET CLIST=LIST
End DoDot:1
+21 IF $GET(CLIST)'=""
Begin DoDot:1
+22 FOR BQI=1:1
SET CMIEN=$PIECE(CLIST,$CHAR(28),BQI)
IF CMIEN=""
QUIT
Begin DoDot:2
+23 SET ANSWR=$$FND(CMIEN)
SET MESG=""
SET MSG=""
SET HNDLR=""
KILL VAL
+24 SET RES=$PIECE(ANSWR,U,1)
SET MSG=$PIECE(ANSWR,U,2)
SET VAL(RES)=$GET(VAL(RES))_MSG_"; "
+25 SET ANSWF=$$FOL(CMIEN)
+26 SET RES=$PIECE(ANSWF,U,1)
SET MSG=$PIECE(ANSWF,U,2)
SET VAL(RES)=$GET(VAL(RES))_MSG_"; "
+27 SET ANSWN=$$NOT(CMIEN)
+28 SET RES=$PIECE(ANSWN,U,1)
SET MSG=$PIECE(ANSWN,U,2)
SET VAL(RES)=$GET(VAL(RES))_MSG_"; "
+29 SET RES=$ORDER(VAL(""))
+30 IF RES=-1
SET MESG=$$TKO^BQIUL1(VAL(RES),"; ")
SET HNDLR="O"
+31 SET II=II+1
SET @DATA@(II)=RES_"^"_$GET(MESG)_U_$GET(HNDLR)_U_$GET(CMIEN)_$CHAR(30)
End DoDot:2
End DoDot:1
+32 ;
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
+7 ;
FND(CMIEN) ;EP - Findings complete?
+1 NEW FN,FNDATA,FND
+2 SET (FN,FND)=0
FOR
SET FN=$ORDER(^BTPWP(CMIEN,10,FN))
IF 'FN
QUIT
Begin DoDot:1
+3 ;Bad Entry
IF $$GET1^DIQ(90620.01,FN_","_CMIEN_",",".01","I")=""
QUIT
+4 ;Entered-in-Error
IF $$GET1^DIQ(90620.01,FN_","_CMIEN_",",".08","I")="Y"
QUIT
+5 SET FND=1
End DoDot:1
IF FND
QUIT
+6 IF FND=0
QUIT "-1"_U_"No findings found"
+7 QUIT "1^"
+8 ;
FOL(CMIEN) ;EP - Followup complete?
+1 NEW FN,FOL,FNDATA
+2 ;
+3 ;First check if follow-up is needed
+4 SET FN=$$GET1^DIQ(90620,CMIEN_",",1.11,"I")
IF FN="N"
QUIT "1^"
+5 SET (FN,FOL)=0
FOR
SET FN=$ORDER(^BTPWP(CMIEN,12,FN))
IF 'FN
QUIT
Begin DoDot:1
+6 ;Bad Entry
IF $$GET1^DIQ(90620.012,FN_","_CMIEN_",",".01","I")=""
QUIT
+7 ;Entered-in-Error
IF $$GET1^DIQ(90620.012,FN_","_CMIEN_",",".07","I")="Y"
QUIT
+8 SET FOL=1
End DoDot:1
IF FOL
QUIT
+9 IF FOL=0
QUIT "-1"_U_"No followup found"
+10 QUIT "1^"
+11 ;
NOT(CMIEN) ;EP - Notification complete?
+1 NEW FN,NOT,FNDATA
+2 SET (FN,NOT)=0
FOR
SET FN=$ORDER(^BTPWP(CMIEN,11,FN))
IF 'FN
QUIT
Begin DoDot:1
+3 ;Bad Entry
IF $$GET1^DIQ(90620.01,FN_","_CMIEN_",",".01","I")=""
QUIT
+4 ;Entered-in-Error
IF $$GET1^DIQ(90620.01,FN_","_CMIEN_",",".09","I")="Y"
QUIT
+5 SET NOT=1
End DoDot:1
IF NOT
QUIT
+6 IF NOT=0
QUIT "-1"_U_"No Notifications found"
+7 QUIT "1^"
