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
