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