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

BGOVAST.m

Go to the documentation of this file. 
  1. BGOVAST ; IHS/BAO/TMD - Manage V ASTHMA ;08-Jul-2013 14:14;DU
  1.  ;;1.1;BGO COMPONENTS;**1,3,6,10,11,13**;Mar 20, 2007;Build 16
  1.  ;---------------------------------------------
  1.  ; Get V Asthma entries by individual entry, visit, or patient
  1.  ;  INP = Patient IEN [1] ^ V File IEN [2] ^ Visit IEN [3]
  1. GET(RET,INP) ;EP
  1.  D VFGET^BGOUTL2(.RET,INP,$$FNUM,".03;.04;.05;.06;.07;.08;.09;.11;.12;1201;1204")
  1.  Q
  1.  ;Get last asthma control data for a patient
  1.  ;INP = Patient IEN [1]
  1.  ;Ret=Paient [1] ^Visit IEN [2] ^ date [3] ^control [4]
  1. GET2(RET,INP) ;EP
  1.  N DFN,ADT,CONTROL,IEN,X,VST,DTE
  1.  S CONTROL=""
  1.  S DFN=$P(INP,U,1)
  1.  S ADT="" S ADT=$O(^AUPNVAST("AAC",DFN,ADT)) Q:ADT=""  D
  1.  .S IEN="" S IEN=$O(^AUPNVAST("AAC",DFN,ADT,IEN),-1) Q:IEN=""  D
  1.  ..S CONTROL=$G(^AUPNVAST("AAC",DFN,ADT,IEN))
  1.  S X=$S(CONTROL="W":"WELL CONTROLLED",CONTROL="N":"NOT WELL CONTROLLED",CONTROL="V":"VERY POORLY CONTROLLED",1:"")
  1.  S VST=$$GET1^DIQ(9000010.41,IEN,.03,"I")
  1.  S DTE=$$GET1^DIQ(9000010.41,IEN,.03,"E")
  1.  S RET=DFN_U_VST_U_DTE_U_X
  1.  Q
  1.  ;Get asthma registry entry
  1. GETREG(RET,DFN) ;EP
  1.  S RET=$$GETREC^BGOUTL(90181.01,DFN,".02;.06;.07;.08;.12")
  1.  Q
  1.  ; Fetch asthma registry note
  1. GETNOTE(RET,DFN) ;EP
  1.  K RET
  1.  I '$D(^BATREG(DFN,0)) S RET(0)=$$ERR^BGOUTL(1071) Q
  1.  I $$GET1^DIQ(90181.01,DFN,1100,"","RET")
  1.  Q
  1.  ; Add/edit V Asthma Registry entry
  1.  ;  INP = V File IEN [1] ^ Visit IEN [2] ^ Asthma Status [4]
  1. SET(RET,INP) ;EP
  1.  N VIEN,FNUM,VFIEN,VIEN,VFNEW,FDA
  1.  S RET="",FNUM=$$FNUM
  1.  S VFIEN=+INP
  1.  S VFNEW='VFIEN
  1.  S VIEN=$P(INP,U,2)
  1.  S RET=$$CHKVISIT^BGOUTL(VIEN)
  1.  Q:RET
  1.  I 'VFIEN S VFIEN=$O(^AUPNVAST("AD",VIEN,VFIEN),-1)
  1.  I 'VFIEN D  Q:'VFIEN
  1.  .D VFNEW^BGOUTL2(.RET,FNUM,1,VIEN)
  1.  .S:RET>0 VFIEN=RET,RET=""
  1.  S FDA=$NA(FDA(FNUM,VFIEN_","))
  1.  S @FDA@(.14)=$P(INP,U,3)
  1.  S @FDA@(1204)="`"_DUZ
  1.  S @FDA@(1201)="N"
  1.  ;IHS/MSC/MGH new fields patch 11
  1.  I VFNEW D
  1.  .S @FDA@(1216)="N"
  1.  .S @FDA@(1217)="`"_DUZ
  1.  S @FDA@(1218)="N"
  1.  S @FDA@(1219)="`"_DUZ
  1.  S RET=$$UPDATE^BGOUTL(.FDA,"E")
  1.  I RET,VFNEW,$$DELETE^BGOUTL(FNUM,VFIEN)
  1.  D:'RET VFEVT^BGOUTL2(FNUM,VFIEN,'VFNEW)
  1.  S:'RET RET=VFIEN
  1.  Q
  1.  ; Add/edit Asthma Registry entry
  1.  ;  INP = Patient IEN [1] ^ Status [2] ^ Last Visit Date [3] ^ Date Due [4] ^ Next Appt Date [5] ^
  1.  ;        Case Manager [6] ^ Note [7]
  1. SETREG(RET,INP) ;EP
  1.  N DFN,IENS,FDA,NOTE
  1.  S DFN=+INP
  1.  S IENS=$S($D(^BATREG(DFN)):DFN_",",1:"+1,")
  1.  S FDA=$NA(FDA(90181.01,IENS))
  1.  S:$E(IENS)="+" @FDA@(.01)="`"_DFN
  1.  S @FDA@(.02)=$P(INP,U,2)
  1.  S @FDA@(.06)=$P(INP,U,3)
  1.  ;S @FDA@(.07)=$P(INP,U,4)
  1.  S:$P(INP,U,3) @FDA@(.07)=$$FMADD^XLFDT($P(INP,U,3),180)
  1.  S @FDA@(.08)=$P(INP,U,5)
  1.  S @FDA@(.12)=$$PTR($P(INP,U,6))
  1.  S NOTE=$P(INP,U,7)
  1.  S @FDA@(1100)=$$TOWP^BGOUTL("NOTE")
  1.  S RET=$$UPDATE^BGOUTL(.FDA,"E")
  1.  Q
  1. PTR(X) Q $S($L(X):"`"_X,1:"")
  1.  ; Delete a V Allergy entry
  1. DEL(RET,VFIEN) ;EP
  1.  D VFDEL^BGOUTL2(.RET,$$FNUM,VFIEN)
  1.  Q
  1.  ;Get RED and YELLOW zone data
  1.  ;INP = Patient IEN [1]
  1.  ;Ret= RED [1] ^ RED ZONE [2] ^ DATE [3]
  1. GETZONE(RET,INP) ;EP
  1.  N DFN,EDT,ADT,CONTROL,IEN,YDT,RDT,DTE,VST,RED,YELLOW,CNT
  1.  S CNT=0
  1.  S RET=$$TMPGBL^BGOUTL
  1.  S (RED,YELLOW)=""
  1.  S DFN=$P(INP,U,1)
  1.  S ADT="" F  S ADT=$O(^AUPNVAST("AA",DFN,ADT)) Q:ADT=""  D
  1.  .S IEN="" F  S IEN=$O(^AUPNVAST("AA",DFN,ADT,IEN),-1) Q:IEN=""  D
  1.  ..S EDT=$P($G(^AUPNVAST(IEN,12)),U,1)
  1.  ..I EDT="" D
  1.  ...S VST=$P($G(^AUPNVAST(IEN,0)),U,3)
  1.  ...S EDT=$P($G(^AUPNVSIT(VST,0)),U,1)
  1.  ..S RED=$P($G(^AUPNVAST(IEN,13)),U,1),RDT=9999999-ADT
  1.  ..S YELLOW=$P($G(^AUPNVAST(IEN,11)),U,1),YDT=9999999-ADT
  1.  ..Q:RED=""&(YELLOW="")
  1.  ..S CNT=CNT+1 S @RET@(CNT)=IEN_U_"RED"_U_RED_U_EDT
  1.  ..S CNT=CNT+1 S @RET@(CNT)=IEN_U_"YELL0W"_U_YELLOW_U_EDT
  1.  Q
  1. SETZONE(RET,DFN,VIEN,INP) ;EP to set red and yellow zone instructions
  1.  N RET,FNUM,VFIEN,INSTR,DATA,OLDR,OLDY
  1.  S RET="",FNUM=$$FNUM
  1.  S RET=$$CHKVISIT^BGOUTL(VIEN,DFN)
  1.  Q:RET
  1.  S VFIEN="" S VFIEN=$O(^AUPNVAST("AD",VIEN,VFIEN),-1)
  1.  S VFNEW='VFIEN
  1.  ;If RED and YELLOW already set for this visit, make a new entry
  1.  I VFIEN D
  1.  .S OLDR=$$GET1^DIQ(9000010.41,VFIEN,1301)
  1.  .S OLDY=$$GET1^DIQ(9000010.41,VFIEN,1101)
  1.  .I (OLDR'="")!(OLDY'="") S VFIEN=""
  1.  I 'VFIEN D  Q:'VFIEN
  1.  .D VFNEW^BGOUTL2(.RET,FNUM,1,VIEN)
  1.  .S:RET>0 VFIEN=RET,RET=""
  1.  S FDA=$NA(FDA(FNUM,VFIEN_","))
  1.  S INSTR="" F  S INSTR=$O(INP(INSTR)) Q:INSTR=""  D
  1.  .S DATA=$G(INP(INSTR))
  1.  .I $P(DATA,U,2)="" S $P(DATA,U,2)="@"
  1.  .I $P(DATA,U,1)="R" S @FDA@(1301)=$P(DATA,U,2)
  1.  .I $P(DATA,U,1)="Y" S @FDA@(1101)=$P(DATA,U,2)
  1.  S @FDA@(1204)="`"_DUZ
  1.  S @FDA@(1201)="N"
  1.  I VFNEW D
  1.  .S @FDA@(1216)="N"
  1.  .S @FDA@(1217)="`"_DUZ
  1.  S @FDA@(1218)="N"
  1.  S @FDA@(1219)="`"_DUZ
  1.  S RET=$$UPDATE^BGOUTL(.FDA,"E")
  1.  I RET,VFNEW,$$DELETE^BGOUTL(FNUM,VFIEN)
  1.  D:'RET VFEVT^BGOUTL2(FNUM,VFIEN,'VFNEW)
  1.  S:'RET RET=VFIEN
  1.  Q
  1.  ; Asthma education topic IEN
  1. EDTOP() Q $O(^AUTTEDT("B","ASM-SMP",0))
  1.  ; Return V File #
  1. FNUM() Q 9000010.41