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

BQIVFADD.m

Go to the documentation of this file. 
  1. BQIVFADD ;PRXM/HC/ALA-Add new Vfile entry ; 09 Apr 2007  5:48 PM
  1.  ;;2.2;ICARE MANAGEMENT SYSTEM;;Jul 28, 2011;Build 37
  1.  Q
  1.  ;
  1. EN(DATA,DFN,VFILE,MORE,VPARMS,EPARMS) ;EP -- BQI ADD NEW VFILE ENTRY
  1.  ;
  1.  ;Input
  1.  ;  DFN    - Patient's IEN
  1.  ;  VFILE  - Vfile add new entry to
  1.  ;  MORE   - More entries for the same date
  1.  ;  VPARMS - Visit parameters
  1.  ;  EPARMS - Event parameters
  1.  ;
  1.  NEW UID,II,VFIEN,LIST,BQ,PFIEN,PRFLD,PRVAL,CLN,APCDPAT,CHIEN,PDATA,TBFIL
  1.  NEW APCDDATE,APCDTCPT,QUALIF
  1.  S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1.  S DATA=$NA(^TMP("BQIVFADD",UID)),MORE=$G(MORE)
  1.  K @DATA
  1.  S II=0
  1.  NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIVFADD D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
  1.  ;
  1.  S @DATA@(II)="I00010RESULT"_$C(30)
  1.  ;
  1.  S VFILE=$G(VFILE,"") I VFILE="" S BMXSEC="No Vfile selected" Q
  1.  ;
  1.  ; Get the visit parameters
  1.  S VPARMS=$G(VPARMS,"")
  1.  I VPARMS="" D
  1.  . S LIST="",BN=""
  1.  . F  S BN=$O(VPARMS(BN)) Q:BN=""  S LIST=LIST_VPARMS(BN)
  1.  . K VPARMS
  1.  . S VPARMS=LIST
  1.  . K LIST
  1.  ;
  1.  ;Get the PCC event parameters
  1.  S EPARMS=$G(EPARMS,"")
  1.  I EPARMS="" D
  1.  . S LIST="",BN=""
  1.  . F  S BN=$O(EPARMS(BN)) Q:BN=""  S LIST=LIST_EPARMS(BN)
  1.  . K EPARMS
  1.  . S EPARMS=LIST
  1.  . K LIST
  1.  ;
  1.  ; Parse the visit parameters
  1.  K APCDALVR
  1.  F BQ=1:1:$L(VPARMS,$C(28)) D
  1.  . NEW VFIEN
  1.  . S VFIEN=$$FIND1^DIC(90506.3,"","MX","PCC Visit","","","ERROR")
  1.  . S PDATA=$P(VPARMS,$C(28),BQ) Q:PDATA=""
  1.  . S NAME=$P(PDATA,"=",1),VALUE=$P(PDATA,"=",2,99)
  1.  . I VALUE="" Q
  1.  . S PFIEN=$O(^BQI(90506.3,VFIEN,10,"AC",NAME,"")) Q:PFIEN=""
  1.  . I "AD"[$P(^BQI(90506.3,VFIEN,10,PFIEN,1),U,1) S VALUE=$$DATE^BQIUL1(VALUE)
  1.  . I $P(^BQI(90506.3,VFIEN,10,PFIEN,1),U,1)="C" D
  1.  .. S CHIEN=$O(^BQI(90506.3,VFIEN,10,PFIEN,5,"B",VALUE,"")) I CHIEN="" Q
  1.  .. S VALUE=$P(^BQI(90506.3,VFIEN,10,PFIEN,5,CHIEN,0),U,2)
  1.  . S APCDALVR(NAME)=VALUE
  1.  S APCDALVR("APCDPAT")=DFN,APCDPAT=DFN
  1.  S APCDALVR("APCDANE")="",APCDALVR("AUPNTALK")=""
  1.  S APCDALVR("APCDLOC")=$S($G(APCDALVR("APCDLOC"))'="":APCDALVR("APCDLOC"),1:DUZ(2))
  1.  S APCDALVR("APCDTYPE")=$G(APCDALVR("APCDTYPE"),"I")
  1.  S APCDALVR("APCDCAT")=$G(APCDALVR("APCDCAT"),"E")
  1.  S APCDALVR("APCDCLN")=$G(CLN,"")
  1.  I $G(MORE)'="" S APCDALVR("APCDAUTO")=1
  1.  ;
  1.  ;  Create visit and then update other Vfiles
  1.  D EN^APCDALV
  1.  ; Check for error
  1.  I '$G(APCDALVR("APCDAFLG")) S VISIT=$G(APCDALVR("APCDVSIT"))
  1.  I $G(APCDALVR("APCDAFLG"))=2 S RESULT=-1 G DONE
  1.  ; 
  1.  ; If there is an outside provider, set it separately
  1.  I $G(APCDALVR("APCDTOPR"))'="" D
  1.  . S BQIUPD(9000010,VISIT_",",1210)=$G(APCDALVR("APCDTOPR"))
  1.  . D FILE^DIE("","BQIUPD","ERROR")
  1.  . K BQIUPD
  1.  ;
  1.  ; Determine the input template for the event
  1.  I VFILE=9000010.01 S VFIEN=$O(^BQI(90506.3,"B","Measurement",""))
  1.  E  S VFIEN=$$FIND1^DIC(90506.3,"","M",VFILE,"","","ERROR")
  1.  S VFILE=$$GET1^DIQ(90506.3,VFIEN_",",.02,"E")
  1.  S APCDALVR("APCDATMP")="[APCDALVR "_VFILE_" (ADD)]"
  1.  ;
  1.  ; Parse the event parameters
  1.   F BQ=1:1:$L(EPARMS,$C(28)) D
  1.  . S PDATA=$P(EPARMS,$C(28),BQ) Q:PDATA=""
  1.  . S NAME=$P(PDATA,"=",1),VALUE=$P(PDATA,"=",2,99)
  1.  . I VALUE="" Q
  1.  . S PFIEN=$O(^BQI(90506.3,VFIEN,10,"AC",NAME,""))
  1.  . I "AD"[$P(^BQI(90506.3,VFIEN,10,PFIEN,1),U,1) S VALUE=$$DATE^BQIUL1(VALUE)
  1.  . I $P(^BQI(90506.3,VFIEN,10,PFIEN,1),U,1)="C" D
  1.  .. S CHIEN=$O(^BQI(90506.3,VFIEN,10,PFIEN,5,"B",VALUE,"")) I CHIEN="" Q
  1.  .. S VALUE=$P(^BQI(90506.3,VFIEN,10,PFIEN,5,CHIEN,0),U,2)
  1.  . S APCDALVR(NAME)=VALUE
  1.  . S @NAME=VALUE
  1.  . I NAME="VITDTM" S APCDALVR("APCDTCDT")=$G(@NAME)
  1.  ;
  1.  ;Check fields for pointers
  1.  S PRFLD=""
  1.  F  S PRFLD=$O(^BQI(90506.3,VFIEN,10,"AC",PRFLD)) Q:PRFLD=""  D
  1.  . I $G(APCDALVR(PRFLD))="" Q
  1.  . S PFIEN=$O(^BQI(90506.3,VFIEN,10,"AC",PRFLD,""))
  1.  . S PTYP=$P(^BQI(90506.3,VFIEN,10,PFIEN,1),U,1)
  1.  . I PTYP'="T" Q
  1.  . S PRVAL=APCDALVR(PRFLD)
  1.  . I PRFLD="APCDTPRV" Q
  1.  . S APCDALVR(PRFLD)="`"_PRVAL
  1.  ;
  1.  ; Check for code set versioning
  1.  ;I VFILE=9000010.18 D
  1.  ;. I $G(APCDDATE)="" S APCDDATE=$P(^AUPNVSIT(VISIT,0),U,1)\1
  1.  ;. I $G(APCDTCPT)'="" D CPT^BQIVFVAL(APCDDATE,APCDTCPT)
  1.  ;. I RESULT=1 S APCDALVR("DIFGLINE")=1
  1.  ;. I $$PATCH^XPDUTL("BJPC*2.0*1") K APCDALVR("DIFGLINE")
  1.  ;
  1.  ; Create V files
  1.  D EN^APCDALVR
  1.  ; Check for error
  1.  I '$G(APCDALVR("APCDAFLG")) S RESULT=1
  1.  I $G(APCDALVR("APCDAFLG"))=2 S RESULT=-1
  1.  ;
  1.  I $G(QUALIF)'="",VFILE=9000010.01,RESULT=1 S IEN=$G(APCDALVR("APCDADFN")) D QLF
  1.  ;
  1.  ; Cleanup
  1.  K APCDALVR
  1.  ;
  1. DONE ;
  1.  S II=II+1,@DATA@(II)=RESULT_$C(30)
  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 $G(II)="" S II=0
  1.  I $G(UID)="" S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1.  I $G(DATA)="" S DATA=$NA(^TMP("BQIVFADD",UID))
  1.  S II=II+1,@DATA@(II)=$C(31)
  1.  Q
  1.  ;
  1. QLF ; Update Qualifiers
  1.  I $G(^AUPNVMSR(IEN,5,0))="" S ^AUPNVMSR(IEN,5,0)="^9000010.015PA^^"
  1.  NEW DIC,DA,X,BJ
  1.  S DA(1)=IEN
  1.  S DLAYGO=9000010.015,DIC="^AUPNVMSR("_DA(1)_",5,",DIC("P")=DLAYGO,DIC(0)="L"
  1.  F BJ=1:1 S X=$P(QUALIF,$C(29),BJ) Q:X=""  K DO,DD D FILE^DICN
  1.  Q