- BTPWVVAL ;VNGT/HS/ALA-CMET VDEF Validation Program ; 03 Nov 2009 5:46 PM
- ;;1.0;CARE MANAGEMENT EVENT TRACKING;;Feb 07, 2011
- ;
- VAL(DATA,VFILE,PARMS) ;EP -- BTPW VFILE DATA VALIDATION
- ;
- ;Input
- ; VFILE - The vfile number or name
- ; PARMS - The parameters being checked for validation
- ;
- NEW UID,II,BQ,LIST,BN,PDATA,NAME,VALUE,HDR,CODN,VALID,VALFLD,BI,VFLD,TYPE,X,RESULT
- NEW VFIEN,MSG,HNDLR,IEN
- S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
- S DATA=$NA(^TMP("BTPWVVAL",UID))
- K @DATA
- S II=0,MSG=""
- NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BTPWVVAL D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
- S VFILE=$G(VFILE,"") I VFILE="" S BMXSEC="RPC Failed: No Vfile selected" Q
- S VFIEN=$$FIND1^DIC(90506.3,"","MO",VFILE,"","","ERROR")
- ;
- S @DATA@(II)="I00010RESULT^T00100MSG^T00001HANDLER^I00010IEN"_$C(30)
- ; Get list of parameters
- S PARMS=$G(PARMS,"")
- I PARMS="" D
- . S LIST="",BN=""
- . F S BN=$O(PARMS(BN)) Q:BN="" S LIST=LIST_PARMS(BN)
- . K PARMS
- . S PARMS=LIST
- . K LIST
- ;
- I PARMS="" S II=II+1,@DATA@(II)="1^"_$G(MSG)_U_$G(HNDLR)_U_$G(IEN)_$C(30) G DONE
- ; Parse parameters
- F BQ=1:1:$L(PARMS,$C(28)) D Q:$G(BMXSEC)'=""
- . S PDATA=$P(PARMS,$C(28),BQ) Q:PDATA=""
- . S NAME=$P(PDATA,"=",1),VALUE=$P(PDATA,"=",2,99)
- . S @NAME=VALUE
- . ; If value is BQIDFN, it exists at the PCC Visit level not individual
- . ; V File level.
- . I VFILE'=9000010&(NAME="BQIDFN"!(NAME="APCDDATE")) Q
- . S CODN=$O(^BQI(90506.3,VFIEN,10,"AC",NAME,""))
- . I CODN="" S BMXSEC="RPC Failed: Parameter does not exist for this Vfile" Q
- . I $G(VALID)="" S VALID=$P($G(^BQI(90506.3,VFIEN,10,CODN,2)),U,2)
- . I $G(VALFLD)="" S VALFLD=$P($G(^BQI(90506.3,VFIEN,10,CODN,2)),U,1)
- ;
- ; Check that values exist for all fields needed for the validation
- F BI=1:1:$L(VALFLD,";") S VFLD=$P(VALFLD,";",BI) D
- . I VFLD["*" S VFLD=$$STRIP^XLFSTR(VFLD,"*") Q
- . I $G(@VFLD)="" S BMXSEC="RPC Failed: Missing validation value for "_VFLD
- I $G(BMXSEC)'="" Q
- ;
- S VALID=$TR(VALID,"~","^"),RESULT=0
- ; Execute the validation tag
- D @VALID
- S II=II+1,@DATA@(II)=RESULT_U_$G(MSG)_U_$G(HNDLR)_U_$G(IEN)_$C(30)
- ; Clean up validation variables
- F BI=1:1:$L(VALFLD,";") D
- . S VFLD=$P(VALFLD,";",BI),VFLD=$$STRIP^XLFSTR(VFLD,"*")
- . K @VFLD
- ;
- 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
- ;
- SIG(BTPWSIGN) ;EP - Signature validation
- D SIGCHK^BMXRPC3(.RESULT,BTPWSIGN)
- I RESULT=0 S RESULT=-1,MSG="Signature not validated" Q
- S RESULT=1
- Q
- BTPWVVAL ;VNGT/HS/ALA-CMET VDEF Validation Program ; 03 Nov 2009 5:46 PM
- +1 ;;1.0;CARE MANAGEMENT EVENT TRACKING;;Feb 07, 2011
- +2 ;
- VAL(DATA,VFILE,PARMS) ;EP -- BTPW VFILE DATA VALIDATION
- +1 ;
- +2 ;Input
- +3 ; VFILE - The vfile number or name
- +4 ; PARMS - The parameters being checked for validation
- +5 ;
- +6 NEW UID,II,BQ,LIST,BN,PDATA,NAME,VALUE,HDR,CODN,VALID,VALFLD,BI,VFLD,TYPE,X,RESULT
- +7 NEW VFIEN,MSG,HNDLR,IEN
- +8 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
- +9 SET DATA=$NAME(^TMP("BTPWVVAL",UID))
- +10 KILL @DATA
- +11 SET II=0
- SET MSG=""
- +12 ; SAC 2006 2.2.3.3.2
- NEW $ESTACK,$ETRAP
- SET $ETRAP="D ERR^BTPWVVAL D UNWIND^%ZTER"
- +13 SET VFILE=$GET(VFILE,"")
- IF VFILE=""
- SET BMXSEC="RPC Failed: No Vfile selected"
- QUIT
- +14 SET VFIEN=$$FIND1^DIC(90506.3,"","MO",VFILE,"","","ERROR")
- +15 ;
- +16 SET @DATA@(II)="I00010RESULT^T00100MSG^T00001HANDLER^I00010IEN"_$CHAR(30)
- +17 ; Get list of parameters
- +18 SET PARMS=$GET(PARMS,"")
- +19 IF PARMS=""
- Begin DoDot:1
- +20 SET LIST=""
- SET BN=""
- +21 FOR
- SET BN=$ORDER(PARMS(BN))
- IF BN=""
- QUIT
- SET LIST=LIST_PARMS(BN)
- +22 KILL PARMS
- +23 SET PARMS=LIST
- +24 KILL LIST
- End DoDot:1
- +25 ;
- +26 IF PARMS=""
- SET II=II+1
- SET @DATA@(II)="1^"_$GET(MSG)_U_$GET(HNDLR)_U_$GET(IEN)_$CHAR(30)
- GOTO DONE
- +27 ; Parse parameters
- +28 FOR BQ=1:1:$LENGTH(PARMS,$CHAR(28))
- Begin DoDot:1
- +29 SET PDATA=$PIECE(PARMS,$CHAR(28),BQ)
- IF PDATA=""
- QUIT
- +30 SET NAME=$PIECE(PDATA,"=",1)
- SET VALUE=$PIECE(PDATA,"=",2,99)
- +31 SET @NAME=VALUE
- +32 ; If value is BQIDFN, it exists at the PCC Visit level not individual
- +33 ; V File level.
- +34 IF VFILE'=9000010&(NAME="BQIDFN"!(NAME="APCDDATE"))
- QUIT
- +35 SET CODN=$ORDER(^BQI(90506.3,VFIEN,10,"AC",NAME,""))
- +36 IF CODN=""
- SET BMXSEC="RPC Failed: Parameter does not exist for this Vfile"
- QUIT
- +37 IF $GET(VALID)=""
- SET VALID=$PIECE($GET(^BQI(90506.3,VFIEN,10,CODN,2)),U,2)
- +38 IF $GET(VALFLD)=""
- SET VALFLD=$PIECE($GET(^BQI(90506.3,VFIEN,10,CODN,2)),U,1)
- End DoDot:1
- IF $GET(BMXSEC)'=""
- QUIT
- +39 ;
- +40 ; Check that values exist for all fields needed for the validation
- +41 FOR BI=1:1:$LENGTH(VALFLD,";")
- SET VFLD=$PIECE(VALFLD,";",BI)
- Begin DoDot:1
- +42 IF VFLD["*"
- SET VFLD=$$STRIP^XLFSTR(VFLD,"*")
- QUIT
- +43 IF $GET(@VFLD)=""
- SET BMXSEC="RPC Failed: Missing validation value for "_VFLD
- End DoDot:1
- +44 IF $GET(BMXSEC)'=""
- QUIT
- +45 ;
- +46 SET VALID=$TRANSLATE(VALID,"~","^")
- SET RESULT=0
- +47 ; Execute the validation tag
- +48 DO @VALID
- +49 SET II=II+1
- SET @DATA@(II)=RESULT_U_$GET(MSG)_U_$GET(HNDLR)_U_$GET(IEN)_$CHAR(30)
- +50 ; Clean up validation variables
- +51 FOR BI=1:1:$LENGTH(VALFLD,";")
- Begin DoDot:1
- +52 SET VFLD=$PIECE(VALFLD,";",BI)
- SET VFLD=$$STRIP^XLFSTR(VFLD,"*")
- +53 KILL @VFLD
- End DoDot:1
- +54 ;
- 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 ;
- SIG(BTPWSIGN) ;EP - Signature validation
- +1 DO SIGCHK^BMXRPC3(.RESULT,BTPWSIGN)
- +2 IF RESULT=0
- SET RESULT=-1
- SET MSG="Signature not validated"
- QUIT
- +3 SET RESULT=1
- +4 QUIT
