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

BGOVAMI1.m

Go to the documentation of this file. 
  1. BGOVAMI1 ; MSC/JS - VAMI Utilities ;28-Feb-2014 10:27;DU
  1.  ;;1.1;BGO COMPONENTS;**13,14**;Mar 20, 2007;Build 16
  1.  ;
  1.  ;01.23.14 MSC/JS - Move GETVFIEN and NARR here to keep routine within 15k size limits
  1.  ;02.06.14 MSC/MGH - Changed refusal to try and find exisiting one on edit
  1.  ;
  1. NARR(DESCT,NARR) ;Provider narrative is now provider text | descriptive SNOMED CT
  1.  N NARRPTR,RET
  1.  S NARRPTR=0
  1.  S NARR=NARR_"|"_DESCT
  1.  I $L(NARR) D  Q:RET
  1.  .S RET=$$FNDNARR^BGOUTL2(NARR)
  1.  .S:RET>0 NARRPTR=RET,RET=""
  1.  Q NARRPTR
  1.  ; Fetch V File entries
  1.  ;  INP = Patient IEN (for entries associated with a patient) [1] ^
  1.  ;        V File IEN (for single entry) [2] ^
  1.  ;        Visit IEN (for entries associated with a visit) [3]
  1. GETVFIEN(RET,INP) ;EP
  1.  N DFN,GBL,VFIEN,VIEN,XREF
  1.  S RET=0,GBL=$$ROOT^DILFD($$FNUM,,1)
  1.  I '$L(GBL) S RET=$$ERR^BGOUTL(1069) Q
  1.  S DFN=+INP
  1.  S VFIEN=$P(INP,U,2)
  1.  S VIEN=$P(INP,U,3)
  1.  ; If the VFIEN is present, then use that.
  1.  I VFIEN D
  1.  .I '$D(@GBL@(VFIEN,0)) S RET=$$ERR^BGOUTL(1070)
  1.  .E  S RET=1,RET(1)=VFIEN
  1.  E  I VIEN D
  1.  .S (RET,VFIEN)=0
  1.  .F  S VFIEN=$O(@GBL@("AD",VIEN,VFIEN)) Q:'VFIEN  S RET=RET+1,RET(RET)=VFIEN
  1.  E  I DFN D
  1.  .S VFIEN="",XREF=$$VFPTXREF^BGOUTL2
  1.  .; Return the records newest to oldest
  1.  .F  S VFIEN=$O(@GBL@(XREF,DFN,VFIEN),-1) Q:'VFIEN  S RET=RET+1,RET(RET)=VFIEN
  1.  E  S RET=$$ERR^BGOUTL(1008)
  1.  Q
  1.  ;Add entry to file #9000022 PATIENT REFUSALS FOR SERVICE/NMI for patient refused Therapy
  1.  ;  INP = Refusal IEN [1] ^ Refusal Type [2] ^ Item IEN [3] ^ Patient IEN [4] ^
  1.  ;        Refusal Date [5] ^ Comment [6] ^ Provider IEN [7] ^ Reason [8]
  1. SETREF(DFN,REFRES,REFDT,VFNEW) ; EP
  1.  S RET=""
  1.  I $G(DFN)="" Q RET
  1.  N TYPE,DTDONE,CPT,SNO,RIEN,FOUND
  1.  S RIEN=""
  1.  S TYPE="CPT"
  1.  S CPT=$$GET^XPAR("ALL","BGO AMI THROMBO NOT DONE",1,"E")
  1.  S CPT=$O(^ICPT("BA",$G(CPT)_" ",0))
  1.  S:CPT="" CPT=92975 ;    default to CPT code DISSOLVE CLOT, HEART VESSEL
  1.  I '+REFRES S REFRES=23
  1.  S DTDONE=$P(REFDT,".",1)
  1.  I DTDONE="" S DTDONE="TODAY",DTDONE=$$DT^CIAU(DTDONE)
  1.  I 'VFNEW D
  1.  .S FOUND=0
  1.  .N INV,Y
  1.  .S INV="" F  S INV=$O(^AUPNPREF("AA",DFN,81,CPT,INV)) Q:INV=""!(FOUND=1)  D
  1.  ..S Y=9999999-INV
  1.  ..Q:Y'=DTDONE
  1.  ..S REFIEN=$O(^AUPNPREF("AA",DFN,81,CPT,INV,""))
  1.  ..I +REFIEN S RIEN=REFIEN,FOUND=1
  1.  S INP=RIEN_U_TYPE_U_CPT_U_DFN_U_DTDONE_U_U_DUZ_U_REFRES
  1.  D SET^BGOREF(.RET,INP)
  1.  I RET="" S RET=1
  1.  Q RET
  1.  ;
  1.  ;Delete entry from PATIENT REFUSALS FOR SERVICE/NMI file #9000022 for V AMI record logical delete
  1.  ;  INP = V AMI file ien VFIEN
  1. DELREF(VFIEN) ; EP
  1.  S RET=""
  1.  I $G(VFIEN)="" Q RET
  1.  ;I $G(^AUPNVAMI(VFIEN,5))="" Q RET  ; not a deleted record
  1.  N DECDT,DFN,DNIRDT,DNIRDUZ,FNUM,INVDATE,NOD0,FILIEN,REFIEN,TYPE,CPT
  1.  S NOD0=$G(^AUPNVAMI(VFIEN,0))
  1.  S DFN=$P(NOD0,"^",2),DNIRDT=$P($P(NOD0,"^",15),".",1),DNIRDUZ=$P(NOD0,"^",16)
  1.  I DNIRDT="" S DNIRDT=$P($P(NOD0,"^",12),".",1)  ;Get entered date if it was an edit
  1.  ;I $G(DFN)=""!($G(DNIRDT)="")!($G(DNIRDUZ)="") Q RET
  1.  I $G(DFN)=""!($G(DNIRDT)="") Q RET
  1.  S INVDATE=9999999-DNIRDT
  1.  S CPT=$$GET^XPAR("ALL","BGO AMI THROMBO NOT DONE",1,"E")
  1.  S TYPE=+$$CPT^ICPTCOD(CPT)
  1.  I TYPE<0  Q RET
  1.  N FNUM S FNUM=81 ;  p13 CPT codes only
  1.  S DECDT=0
  1.  F  S DECDT=$O(^AUPNPREF("AA",DFN,FNUM,TYPE,DECDT)) Q:'DECDT  D
  1.  .Q:DECDT'=INVDATE
  1.  .S FILIEN="",FILIEN=$O(^AUPNPREF("AA",DFN,FNUM,TYPE,DECDT,FILIEN))
  1.  .N ENTBY,NOD12
  1.  .S NOD12=$G(^AUPNPREF(FILIEN,12)),ENTBY=$P(NOD12,U,17)
  1.  .Q:ENTBY=""
  1.  .I ENTBY=DNIRDUZ!(DNIRDUZ="") S REFIEN=FILIEN
  1.  I $G(REFIEN)="" Q RET
  1.  N DELRET
  1.  D DEL^BGOREF(.DELRET,REFIEN)
  1.  I DELRET="" S RET=1
  1.  Q RET
  1.  ;
  1.  ;Display V AMI entry fld#.17 DID NOT INIT FIB REASON Snomed code + XPAR CPT code
  1.  ;  DNIR = fld #.17 Snomed code [1]
  1.  ;  checks DNIR value with API call to verify CONCEPT ID code is valid, if not defaults to:
  1.  ;     REFUSAL REASONS file #9999999.102 IEN 17   CONCEPT ID: 275936005
  1.  ;     USE WITH MEDICATION REFUSAL: YES      .07 CODE VALUE: DECLINED SERVICE
  1.  ;     SCREEN: ALL
  1.  ;     CONCEPT ID PREFERRED TERM (c): Patient noncompliance - general (situation)
  1. GETREF(DNIR) ; EP
  1.  N SNOINFO
  1.  S SNOINFO=""
  1.  I +$G(DNIR)="" Q SNOINFO
  1.  NEW CPT,CPTDESC,IN,SNOCHEK,SNODESC
  1.  ;check for valid Snomed ID, input IN (Snomed ID)
  1.  ;Output -
  1.  ; Function returns - [1]^[2]^[3]^[4]
  1.  ; [1] - Description Id of Fully Specified Name
  1.  ; [2] - Fully Specified Name
  1.  ; [3] - Description Id of Preferred Term
  1.  ; [4] - Preferred Term
  1.  S IN=$G(DNIR)_"^^^1" D
  1.  .K ^TMP("BSTSCMCL",$J)
  1.  .S SNOCHEK=$$CONC^BSTSAPI(IN)
  1.  .K ^TMP("BSTSCMCL",$J)
  1.  .S SNODESC=$P(SNOCHEK,"^",2)
  1.  .I SNODESC="" D  ;  stored V Stroke field invalid, use default ID
  1.  ..S IN=275936005_"^^^1"
  1.  ..K ^TMP("BSTSCMCL",$J)
  1.  ..S SNOCHEK=$$CONC^BSTSAPI(IN)
  1.  ..K ^TMP("BSTSCMCL",$J)
  1.  ..S SNODESC=$P(SNOCHEK,"^",2)
  1.  S CPT=$$GET^XPAR("SYS","BGO AMI THROMBO NOT DONE")
  1.  S:CPT="" CPT=92975
  1.  S CPTDESC=$$GET1^DIQ(81,CPT,2,"E")
  1.  S SNOINFO=$G(SNODESC)_" - "_CPTDESC
  1.  Q SNOINFO
  1. DEL(RET2,VFIEN,SUBIEN,SUBFILE) ;Delete subfile entry
  1.  N ERR,DA,DIK,NODE
  1.  S ERR=""
  1.  S DA(1)=VFIEN,DA=+SUBIEN
  1.  S DIK="^AUPNVAMI(DA(1),"_SUBFILE_","
  1.  S:DA ERR=$$DELETE^BGOUTL(DIK,.DA)
  1.  I ERR'="" S RET=RET_"^"_ERR
  1.  Q
  1.  ;
  1.  ; Return V File #
  1.  ; This method signature allows this to be called as a Remote Procedure.
  1. FNUM(RET,INP) S RET=9000010.62
  1.  Q RET