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

BQICEADD.m

Go to the documentation of this file. 
  1. BQICEADD ;GDHD/HCS/ALA-CMET Add Event ; 09 Jan 2017  9:12 AM
  1.  ;;2.6;ICARE MANAGEMENT SYSTEM;;Jul 07, 2017;Build 72
  1.  ;
  1. EN(DATA,DFN,PARMS) ;EP -- BQI ADD NEW EVENT
  1.  NEW CIEN
  1.  NEW ARLDTM
  1.  ;S ARLDTM=$$NOW^XLFDT()
  1.  ;S ^ARLPARMS("BQICEADD",ARLDTM,"DFN")=DFN
  1.  ;S ^ARLPARMS("BQICEADD",ARLDTM,"PARMS")=$G(PARMS)
  1.  S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1.  S DATA=$NA(^TMP("BQICEADD",UID))
  1.  S MORE=$G(MORE,1)
  1.  K @DATA
  1.  S II=0
  1.  NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQICEADD D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
  1.  ;
  1.  S @DATA@(II)="I00010RESULT^I00010QUEUED_CMET_IEN"_$C(30)
  1.  ;
  1.  ; Get the 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.  ; Parse the visit parameters
  1.  K APCDALVR
  1.  F BQ=1:1:$L(PARMS,$C(28)) D
  1.  . NEW VFIEN,PTYP
  1.  . S VFIEN=$$FIND1^DIC(90506.3,"","MX","CMET Add Event","","","ERROR")
  1.  . S PDATA=$P(PARMS,$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.  . S PTYP=$P($G(^BQI(90506.3,VFIEN,10,PFIEN,1)),U,1)
  1.  . ;I "AD"[$P(^BQI(90506.3,VFIEN,10,PFIEN,1),U,1) S VALUE=$$DATE^BQIUL1(VALUE)
  1.  . I PTYP="A"!(PTYP="D") S VALUE=$$DATE^BQIUL1(VALUE)
  1.  . I PTYP="W" D  Q
  1.  .. K BTPWP D WP(VALUE)
  1.  . S @NAME=VALUE
  1.  ;
  1.  F BQ=1:1:$L(PARMS,$C(28)) D
  1.  . NEW VFIEN
  1.  . S VFIEN=$$FIND1^DIC(90506.3,"","MX","PCC Visit","","","ERROR")
  1.  . S PDATA=$P(PARMS,$C(28),BQ) Q:PDATA=""
  1.  . S NAME=$P(PDATA,"=",1),VALUE=$P(PDATA,"=",2,99)
  1.  . I VALUE="" Q
  1.  . I NAME="APCCDATE" S @NAME=VALUE
  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:$$OLOC())
  1.  S APCDALVR("APCDTYPE")=$G(APCDALVR("APCDTYPE"),"I")
  1.  S APCDALVR("APCDCAT")=$G(APCDALVR("APCDCAT"),"E")
  1.  S APCDALVR("APCDCLN")=$G(CLN,"OTHER")
  1.  S APCDDATE=$$DATE^BQIUL1(APCCDATE)
  1.  I $G(MORE)'="" S APCDALVR("APCDAUTO")=1
  1.  S APCDALVR("APCDOPT")=$$FIND1^DIC(19,"","BX","BQIRPC","","","ERROR")
  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.  E  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.  S VFIEN=$O(^BTPW(90621.1,"D",EVTYPE,"")),FRIL=VFIEN
  1.  S VFILE=$$GET1^DIQ(90621.1,VFIEN_",",.02,"E")
  1.  S FREF=$$GET1^DIQ(90621.1,VFIEN_",",.02,"I")
  1.  S APCDALVR("APCDATMP")="[APCDALVR "_FREF_" (ADD)]"
  1.  I EVTYPE="CPT" S APCDALVR("APCDTCPT")=$P(^ICPT(IVALIEN,0),"^",1),APCDALVR("APCDTUN")=1,APCDALVR("APCDTPN")=$$ENARR()
  1.  I EVTYPE="POV" S APCDALVR("APCDTPOV")=$P(^ICD9(IVALIEN,0),"^",1),APCDALVR("APCDTNQ")=$$ENARR(),APCDALVR("APCDTPS")="PRIMARY"
  1.  I EVTYPE="LAB" S APCDALVR("APCDTLAB")=IVALIEN,APCDALVR("APCDTLPV")=$$ENARR(),APCDALVR("APCDTCSF")="RESULTED"
  1.  I EVTYPE="PROCEDURE" S APCDALVR("APCDTPRC")=$P(^ICD0(IVALIEN,0),"^",1),APCDALVR("APCDTNQ")=$$ENARR(),APCDALVR("APCDTPP")="YES"
  1.  ;
  1.  ; Create V files
  1.  D EN^APCDALVR
  1.  ; Check for error
  1.  I '$G(APCDALVR("APCDAFLG")) S RESULT=1
  1.  E  S RESULT=-1
  1.  ; Cleanup
  1.  K APCDALVR
  1.  I RESULT=1 D
  1.  . S GREF=$$ROOT^DILFD(FREF,"",1)
  1.  . S RIEN=$O(@GREF@("AD",VISIT,""))
  1.  . D CM
  1.  ;
  1.  I RESULT=-1 D
  1.  . NEW DA,DIK
  1.  . S DIK="^AUPNVSIT(",DA=VISIT D ^DIK
  1.  ;
  1. DONE ;
  1.  S II=II+1,@DATA@(II)=RESULT_U_$G(CIEN)_$C(30)
  1.  S II=II+1,@DATA@(II)=$C(31)
  1.  K AGE,APCCDATE,APCDDATE,APCDANE,APCDLOC,APCDLOC,BQ,DA,DFN,DOB,EVIEN,EVNAME,EVTYPE,FREF,FRIL,IENS
  1.  K GREFF,II,IVALIEN,MORE,NAME,PARMS,PDATA,PFIEN,RESULT,RIEN,SEX,SSN,VALUE,VFIEN,VFILE,VISIT,VSDTM
  1.  K ^UTILITY($J)
  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("BQICEADD",UID))
  1.  S II=II+1,@DATA@(II)=$C(31)
  1.  Q
  1.  ;
  1. CM ;EP
  1.  NEW DIC,DLAYGO,X,Y,BTPUPD
  1.  S DIC="^BTPWQ(",DIC(0)="LMNZ",DLAYGO=90629,DIC("P")=DLAYGO
  1.  S X=EVIEN
  1.  K DO,DD D FILE^DICN
  1.  S CIEN=+Y
  1.  D UPD(CIEN)
  1.  D CHK
  1.  Q
  1.  ;
  1. UPD(CIEN) ;
  1.  S VSDTM=$P(^AUPNVSIT(VISIT,0),"^",1),IENS=CIEN_","
  1.  S BTPUPD(90629,IENS,.02)=DFN,BTPUPD(90629,IENS,.03)=VSDTM
  1.  S BTPUPD(90629,IENS,.04)=VISIT,BTPUPD(90629,IENS,.05)=RIEN
  1.  S BTPUPD(90629,IENS,.06)=FRIL,BTPUPD(90629,IENS,.07)=$$NOW^XLFDT()
  1.  S BTPUPD(90629,IENS,.09)=$G(WHIEN),BTPUPD(90629,IENS,.1)=$G(RARPT)
  1.  S BTPUPD(90629,IENS,.15)=$G(ACCN)
  1.  S BTPUPD(90629,IENS,.08)="P",BTPUPD(90629,IENS,.12)="Add Manual Event"
  1.  S BTPUPD(90629,IENS,.13)=$$CAT^BTPWPDSP(EVIEN,1),BTPUPD(90629,IENS,.11)=$$NOW^XLFDT()
  1.  S BTPUPD(90629,IENS,.16)=$$GET1^DIQ(9000010,VISIT_",",.06,"I")
  1.  S BTPUPD(90629,IENS,1.02)=$G(BTPWPFND)
  1.  D FILE^DIE("","BTPUPD","ERROR")
  1.  I $D(BTPWP) D WP^DIE(90629,IENS,4,"","BTPWP","ERROR") K BTPWP
  1.  Q
  1.  ;
  1. CHK ; Check to supercede previously existing record
  1.  NEW PIEN,BTPUPD
  1.  S PIEN=""
  1.  F  S PIEN=$O(^BTPWQ("AD",DFN,PIEN)) Q:PIEN=""  D
  1.  . I $P(^BTPWQ(PIEN,0),U,1)'=EVIEN Q
  1.  . I PIEN=CIEN Q
  1.  . I VSDTM>$P(^BTPWQ(PIEN,0),U,3) Q
  1.  . I $P(^BTPWQ(PIEN,0),U,8)="P" D
  1.  .. S BTPUPD(90629,PIEN_",",.08)="S"
  1.  .. D FILE^DIE("","BTPUPD","ERROR")
  1.  ;
  1.  ; Check for possible match with future followup
  1.  NEW TIEN
  1.  S TIEN=""
  1.  F  S TIEN=$O(^BTPWP("AE",DFN,"F",TIEN)) Q:TIEN=""  D
  1.  . I $P(^BTPWP(TIEN,0),U,1)'=EVIEN Q
  1.  . S BTPUPD(90629,CIEN_",",1.01)=TIEN
  1.  . D FILE^DIE("","BTPUPD","ERROR")
  1.  Q
  1.  ;
  1. OLOC() ;EP - Other location
  1.  NEW PRMN,DOM,DIV
  1.  S PRMN=$O(^XTV(8989.51,"B","BEHOENCX OTHER LOCATION",""))
  1.  S DOM=$P(^XTV(8989.3,1,0),"^",1)
  1.  S DIV=$G(DUZ(2))
  1.  S APCDLOC=DIV
  1.  S IEN=$O(^XTV(8989.5,"AC",PRMN,DIV_";DIC(4,","")),APCDLOC=^XTV(8989.5,"AC",PRMN,DIV_";DIC(4,",IEN)
  1.  I IEN="" S IEN=$O(^XTV(8989.5,"AC",PRMN,DOM_";DIC(4.2,","")),APCDLOC=^XTV(8989.5,"AC",PRMN,DOM_";DIC(4.2,",IEN)
  1.  Q APCDLOC
  1.  ;
  1. ENARR() ;EP - Event Narrative
  1.  NEW TEXT
  1.  ;I $G(APCDLOC)="" S APCDLOC=$G(APCDALVR("APCDLOC"))
  1.  ;I APCDLOC'="" S TEXT="Event "_EVNAME_" done at "_$P(^DIC(4,APCDLOC,0),"^",1)_" location"
  1.  S TEXT="CMET manually entered event"
  1.  Q TEXT
  1.  ;
  1. WP(X) ;EP - Process comment
  1.  NEW DIWL,DIWR,BQN
  1.  K ^UTILITY($J,"W")
  1.  S DIWL=1,DIWR=70
  1.  D ^DIWP
  1.  S BQN=""
  1.  F  S BQN=$O(^UTILITY($J,"W",1,BQN)) Q:BQN=""  S BTPWP(BQN)=^UTILITY($J,"W",1,BQN,0)
  1.  Q