- 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^"
