Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BQIVFVAL

BQIVFVAL.m

Go to the documentation of this file. 
  1. BQIVFVAL ;PRXM/HC/ALA-Validate VFILE data ; 10 Apr 2007  12:56 PM
  1.  ;;2.5;ICARE MANAGEMENT SYSTEM;**1**;May 24, 2016;Build 17
  1.  Q
  1.  ;
  1. VAL(DATA,VDEF,PARMS) ;EP -- BQI VFILE DATA VALIDATION
  1.  ;
  1.  ;Input
  1.  ;  VDEF  - The vdefinition name
  1.  ;  VFILE - The vfile number or name
  1.  ;  PARMS - The parameters being checked for validation
  1.  ;
  1.  NEW UID,II,BQ,LIST,BN,PDATA,NAME,VALUE,HDR,CODN,VALID,VALFLD,BI,VFLD,TYPE,X,RESULT
  1.  NEW VFIEN,MSG,HNDLR,IEN
  1.  S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1.  S DATA=$NA(^TMP("BQIVFVAL",UID))
  1.  K @DATA
  1.  S II=0,MSG=""
  1.  NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIVFVAL D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
  1.  S VDEF=$G(VDEF,"") I VDEF="" S BMXSEC="No VDef selected" Q
  1.  S VFIEN=$$FIND1^DIC(90506.3,"","MOX",VDEF,"","","ERROR")
  1.  S VFILE=$P(^BQI(90506.3,VFIEN,0),U,2)
  1.  ;S VFILE=$G(VFILE,"") I VFILE="" S BMXSEC="No Vfile selected" Q
  1.  ;S VFIEN=$$FIND1^DIC(90506.3,"","MO",VFILE,"","","ERROR")
  1.  ;
  1.  S @DATA@(II)="I00010RESULT^T00100MSG^T00001HANDLER^I00010IEN"_$C(30)
  1.  ; Get list of parameters
  1.  S PARMS=$G(PARMS,"")
  1.  I PARMS="" D
  1.  . S LIST="",BN=""
  1.  . F  S BN=$O(PARMS(BN)) Q:BN=""  S LIST=LIST_PARMS(BN)
  1.  . K PARMS
  1.  . S PARMS=LIST
  1.  . K LIST
  1.  ;
  1.  I PARMS="" S II=II+1,@DATA@(II)="1^"_$G(MSG)_U_$G(HNDLR)_U_$G(IEN)_$C(30) G DONE
  1.  ; Parse parameters
  1.  F BQ=1:1:$L(PARMS,$C(28)) D  Q:$G(BMXSEC)'=""
  1.  . S PDATA=$P(PARMS,$C(28),BQ) Q:PDATA=""
  1.  . S NAME=$P(PDATA,"=",1),VALUE=$P(PDATA,"=",2,99)
  1.  . S @NAME=VALUE
  1.  . ; If value is BQIDFN, it exists at the PCC Visit level not individual
  1.  . ; V File level.
  1.  . I VFILE'=9000010&(NAME="BQIDFN"!(NAME="APCDDATE")) Q
  1.  . S CODN=$O(^BQI(90506.3,VFIEN,10,"AC",NAME,""))
  1.  . I CODN="" S BMXSEC="Parameter does not exist for this Vfile" Q
  1.  . I $G(VALID)="" S VALID=$P($G(^BQI(90506.3,VFIEN,10,CODN,2)),U,2)
  1.  . I $G(VALFLD)="" S VALFLD=$P($G(^BQI(90506.3,VFIEN,10,CODN,2)),U,1)
  1.  ;
  1.  ; Check that values exist for all fields needed for the validation
  1.  F BI=1:1:$L(VALFLD,";") S VFLD=$P(VALFLD,";",BI) D
  1.  . I VFLD["*" S VFLD=$$STRIP^XLFSTR(VFLD,"*") Q
  1.  . I $G(@VFLD)="" S BMXSEC="Missing validation value for "_VFLD
  1.  I $G(BMXSEC)'="" Q
  1.  ;
  1.  S VALID=$TR(VALID,"~","^"),RESULT=0
  1.  ; Execute the validation tag
  1.  D @VALID
  1.  S II=II+1,@DATA@(II)=RESULT_U_$G(MSG)_U_$G(HNDLR)_U_$G(IEN)_$C(30)
  1.  ; Clean up validation variables
  1.  F BI=1:1:$L(VALFLD,";") D
  1.  . S VFLD=$P(VALFLD,";",BI),VFLD=$$STRIP^XLFSTR(VFLD,"*")
  1.  . K @VFLD
  1.  ;
  1. DONE ;
  1.  S II=II+1,@DATA@(II)=$C(31)
  1.  Q
  1.  ;
  1. ERR ;
  1.  D ^%ZTER
  1.  NEW Y,ERRDTM
  1.  S Y=$$NOW^XLFDT() X ^DD("DD") S ERRDTM=Y
  1.  S BMXSEC="Recording that an error occurred at "_ERRDTM
  1.  I $D(II),$D(DATA) S II=II+1,@DATA@(II)=$C(31)
  1.  Q
  1.  ;
  1. MSR(TYPE,X) ;EP - Measurement validation
  1.  ; Input
  1.  ;   TYPE = Measurement choice (APCDTTYP)
  1.  ;   X    = value of the measurement (APCDTVAL)
  1.  ;
  1.  NEW BQIXTYP,TTYPE,EXEC
  1.  S TTYPE=TYPE
  1.  ;I TYPE?.N S TTYPE=$P(^AUTTMSR(TYPE,0),U,1)
  1.  ;S BQIXTYP=TTYPE_"^AUPNVMSR"
  1.  S EXEC=$G(^AUTTMSR(TYPE,12))
  1.  I EXEC'="" X EXEC
  1.  ;D @BQIXTYP
  1.  I $G(X)="" S RESULT=-1 Q
  1.  S RESULT=1
  1.  Q
  1.  ;
  1. SKT(RESLT,READ) ;EP - Skin Test
  1.  ;  Input
  1.  ;     RESLT - Result (APCDTRES)
  1.  ;     READ  - Reading (APCDTREA)
  1.  ;  Output
  1.  ;     RESULT=-1 didn't pass validation
  1.  ;     RESULT=1  passed validation
  1.  ;
  1.  ; Only check validation if both values are populated
  1.  I $G(RESLT)=""!($G(READ)="") S RESULT=1 Q
  1.  ;
  1.  ; If result is 'Negative' and result is greater than 10
  1.  I $G(RESLT)="N"&($G(READ)>10) S RESULT=-1 Q
  1.  ;
  1.  I $G(RESLT)'="P"&($G(READ)>10) S RESULT=-1 Q
  1.  ;
  1.  S RESULT=1
  1.  Q
  1.  ;
  1. EXM(EXAM,RESLT) ;EP - Exam result
  1.  ;  Input
  1.  ;    EXAM  - Exam Type
  1.  ;    RESLT - The entered result
  1.  ;
  1.  I EXAM'?.N S EXAM=$$FIND1^DIC(9999999.15,"","B",EXAM,"","","ERROR")
  1.  NEW C
  1.  S C=$P(^AUTTEXAM(EXAM,0),U,2)
  1.  I RESLT="PA",C'=34 S RESULT=-1 Q
  1.  I RESLT="PR",C'=34 S RESULT=-1 Q
  1.  I RESLT="A",C=34 S RESULT=-1 Q
  1.  I RESLT="A",C=35 S RESULT=-1 Q
  1.  I RESLT="A",C=36 S RESULT=-1 Q
  1.  I RESLT="PO",(C'=35&(C'=36)) S RESULT=-1 Q
  1.  S RESULT=1
  1.  Q
  1.  ;
  1. LAB(TEST,RESLT) ;EP - Lab Result
  1.  ;  Input
  1.  ;    TEST  - Lab Test IEN
  1.  ;    RESLT - The entered result
  1.  ;
  1.  ; Take out validation for a lab result for historical entry
  1.  ; Allow them to enter anything they please
  1.  S RESULT=1
  1.  Q
  1.  NEW WHERE,LDATA,X
  1.  S WHERE=$P(^LAB(60,TEST,0),U,12)
  1.  I WHERE="" S RESULT=1 Q
  1.  S LDATA=U_WHERE_"0)"
  1.  S EXEC=$P(@LDATA,U,5,99)
  1.  S X=RESLT X EXEC
  1.  I $G(X)="" S RESULT=-1 Q
  1.  S RESULT=1
  1.  Q
  1.  ;
  1. LOC(LOC) ; EP - Location
  1.  ; Input
  1.  ;   Location IEN
  1.  S RESULT=1
  1.  I $E($$GET1^DIQ(4,LOC_",",.01,"E"),1,5)="OTHER" D
  1.  . I $P($G(^APCDSITE(DUZ(2),0)),U,16)'="Y" S RESULT=-1,MSG="Your site parameters file does not indicate outside location can be entered!" Q
  1.  Q
  1.  ;
  1. VDT(VDAT,DFN) ; EP - Visit Date
  1.  ; Input
  1.  ;   VDAT - Visit date from APCDDATE
  1.  ;   DFN  - Patient IEN
  1.  S RESULT=1
  1.  S DOB=$$GET1^DIQ(2,DFN_",",.03,"I")
  1.  S DOD=$$GET1^DIQ(2,DFN_",",.351,"I")
  1.  S VDAT=$$DATE^BQIUL1(VDAT)
  1.  ;
  1.  I VDAT\1>DT S RESULT=-1,MSG="Future dates not valid" Q
  1.  I VDAT\1<DOB S RESULT=-1,MSG="Date cannot be before Date of Birth ("_$$FMTE^BQIUL1(DOB)_")" Q
  1.  I DOD'="" D
  1.  . I VDAT\1>DOD S RESULT=-1,MSG="Date cannot be after Date of Death ("_$$FMTE^BQIUL1(DOD)_")" Q
  1.  Q
  1.  ;
  1. PDT(PDAT,VDAT,DFN) ; EP - Procedure Date
  1.  ; Input
  1.  ;   PDAT - Procedure date
  1.  ;   VDAT - Visit date from APCDDATE
  1.  ;   DFN  - Patient IEN
  1.  S RESULT=1
  1.  S DOB=$$GET1^DIQ(2,DFN_",",.03,"I")
  1.  S DOD=$$GET1^DIQ(2,DFN_",",.351,"I")
  1.  S VDAT=$$DATE^BQIUL1(VDAT)
  1.  S PDAT=$$DATE^BQIUL1(PDAT)
  1.  ;
  1.  I PDAT<(VDAT\1) S RESULT=-1,MSG="Procedure date cannot be before Visit date" Q
  1.  I PDAT\1>DT S RESULT=-1,MSG="Future dates not valid" Q
  1.  I PDAT\1<DOB S RESULT=-1,MSG="Date cannot be before Date of Birth ("_$$FMTE^BQIUL1(DOB)_")" Q
  1.  I DOD'="" D
  1.  . I PDAT\1>DOD S RESULT=-1,MSG="Date cannot be after Date of Death ("_$$FMTE^BQIUL1(DOD)_")" Q
  1.  Q
  1.  ;
  1. EPRV(APCDTPRO) ; EP - Education Provider
  1.  S RESULT=1
  1.  I $P($G(^VA(200,APCDTPRO,"PS")),U,4)'="" S RESULT=-1,MSG="The provider you selected is not an authorized provider for Patient Education entries."
  1.  Q
  1.  ;
  1. HIVDT(DFN,BKMDXDT,BKMAIDT) ; EP - Initial HIV DX Date
  1.  NEW X,AIDSDT,DOB,BKMIEN,BKMREG,BKMIENS,DA
  1.  S RESULT=1
  1.  I BKMDXDT="",BKMAIDT="" Q
  1.  S BKMIEN=$$BKMIEN^BKMIXX3(DFN)
  1.  S BKMREG=$$BKMREG^BKMIXX3(BKMIEN)
  1.  S DA(1)=BKMIEN,DA=BKMREG
  1.  S BKMIENS=$$IENS^DILF(.DA)
  1.  S AIDSDT=$$DATE^BQIUL1($G(BKMAIDT))
  1.  ; $$GET1^DIQ(90451.01,BKMIENS,5.5,"I"))
  1.  S DOB=$$GET1^DIQ(2,DFN,.03,"I")
  1.  S X=$$DATE^BQIUL1(BKMDXDT)
  1.  I DOB>X S RESULT=-1,MSG="Date cannot be before Date of Birth ("_$$FMTE^BQIUL1(DOB)_")" Q
  1.  I X>DT S RESULT=-1,MSG="Future dates not valid" Q
  1.  I AIDSDT'="",X>AIDSDT S RESULT=-1,MSG="Initial HIV DX Date cannot be later than Initial AIDS DX Date" Q
  1.  Q
  1.  ;
  1. AIDDT(DFN,BKMAIDT,BKMDXDT) ; EP - Initial AIDS DX Date
  1.  NEW X,HIVDT,DOB,BKMIEN,BKMREG,BKMIENS,DA
  1.  S RESULT=1
  1.  I BKMAIDT="",BKMDXDT="" Q
  1.  S BKMIEN=$$BKMIEN^BKMIXX3(DFN)
  1.  S BKMREG=$$BKMREG^BKMIXX3(BKMIEN)
  1.  S DA(1)=BKMIEN,DA=BKMREG
  1.  S BKMIENS=$$IENS^DILF(.DA)
  1.  S HIVDT=$$DATE^BQIUL1($G(BKMDXDT))
  1.  ;$$GET1^DIQ(90451.01,BKMIENS,5,"I")
  1.  S DOB=$$GET1^DIQ(2,DFN,.03,"I")
  1.  S X=$$DATE^BQIUL1(BKMAIDT)
  1.  I DOB>X S RESULT=-1,MSG="Date cannot be before Date of Birth ("_$$FMTE^BQIUL1(DOB)_")" Q
  1.  I X>DT S RESULT=-1,MSG="Future dates not valid" Q
  1.  I HIVDT'="",X<HIVDT S RESULT=-1,MSG="Initial AIDS DX Date cannot be before the Initial HIV DX Date"
  1.  Q
  1.  ;
  1. RDT(SKRDT) ; EP - Skin Test Reading Date
  1.  S SKRDT=$$DATE^BQIUL1($G(SKRDT))
  1.  I SKRDT\1>DT S RESULT=-1,MSG="Future dates not valid" Q
  1.  S RESULT=1
  1.  Q
  1.  ;
  1. BDT(VDAT,DFN) ; EP - Problem Date of Onset
  1.  ; Input
  1.  ;   VDAT - Visit date from APCDDATE
  1.  ;   DFN  - Patient IEN
  1.  S RESULT=1
  1.  I VDAT="" Q
  1.  S DOB=$$GET1^DIQ(2,DFN_",",.03,"I")
  1.  S DOD=$$GET1^DIQ(2,DFN_",",.351,"I")
  1.  S VDAT=$$DATE^BQIUL1(VDAT)
  1.  ;
  1.  I VDAT\1>DT S RESULT=-1,MSG="Future dates not valid" Q
  1.  I VDAT\1<DOB S RESULT=-1,MSG="Date cannot be before Date of Birth ("_$$FMTE^BQIUL1(DOB)_")" Q
  1.  I DOD'="" D
  1.  . I VDAT\1>DOD S RESULT=-1,MSG="Date cannot be after Date of Death ("_$$FMTE^BQIUL1(DOD)_")" Q
  1.  Q
  1.  ;
  1. CLAS(DX,CLS) ; EP - Classification validation
  1.  I $$VERSION^XPDUTL("BJPC")<2.0 S RESULT=1 Q
  1.  NEW X,BQA,TX,LW,HG
  1.  I CLS="" S RESULT=1 Q
  1.  S X=CLS
  1.  S BQA=0 F  S BQA=$O(^APCDPLCL(BQA)) Q:BQA'=+BQA!('$D(X))  D
  1.  . S TX=$P(^APCDPLCL(BQA,0),U,2)
  1.  . Q:TX=""
  1.  . Q:'$D(^ATXAX(TX))
  1.  . Q:'$$ICD^ATXCHK(DX,TX,9)  ;not in this taxonomy
  1.  . S LW=$P(^APCDPLCL(BQA,0),U,3)
  1.  . S HG=$P(^APCDPLCL(BQA,0),U,4)
  1.  . I X<LW!(X>HG) K X
  1.  . Q
  1.  I $G(X)="" S RESULT=-1,MSG="Invalid selection" Q
  1.  S RESULT=1
  1.  Q
  1.  ;
  1. TXNM(AMQQTNAR) ; EP - Taxonomy name validation
  1.  NEW AMQN
  1.  S RESULT=1
  1.  I AMQQTNAR="" S RESULT=-1,MSG="No name provided" Q
  1.  I $D(^ATXAX("B",AMQQTNAR))>0 D  Q
  1.  . S AMQN=$O(^ATXAX("B",AMQQTNAR,""))
  1.  . I DUZ'=$P(^ATXAX(AMQN,0),U,5) S RESULT=-1,MSG="Name already exists and cannot be overwritten except by its creator." Q
  1.  . S RESULT=-1,MSG="Replace existing taxonomy with this one?",HNDLR="O" Q
  1.  Q
  1.  ;
  1. CPT(VDAT,NCPT) ; EP - CPT Code validation
  1.  S RESULT=1
  1.  S VDAT=$$DATE^BQIUL1(VDAT)
  1.  I NCPT="" S RESULT=-1,MSG="No CPT code provided" Q
  1.  I $P($$CPT^ICPTCOD(NCPT,VDAT),U,7)=0 S RESULT=-1,MSG="CPT Code not valid for this visit date" Q
  1.  Q
  1.  ;
  1. IMP(VALUE) ; EP - Imprecise date validation
  1.  S RESULT=1
  1.  S VALUE=$$DATE^BQIUL1(VALUE)
  1.  I VALUE="" S RESULT=-1,MSG="Invalid date" Q
  1.  Q