BGOPROB3 ; IHS/BAO/TMD - Delete PROBLEMS ;11-Aug-2017 11:10;DU
;;1.1;BGO COMPONENTS;*20,23**;Mar 20, 2007;Build 3
; Delete a problem entry
; PRIEN = Problem IEN ^ TYPE ^ DELETE REASON ^ OTHER^PROB ID
DEL(RET,PRIEN) ;EP
N FPIEN,FPNUM,ZN,REASON,CMMT,IENS,IEN2,FDA
D CHK^BGOPROB2(.RET,PRIEN)
Q:+RET<0
I $P(PRIEN,U,2)="P"&(+$P(PRIEN,U,5)>8999) D
.S PRIEN=$P(PRIEN,U,1)
.S FPNUM=9000013
.S RET=$$DELETE^BGOUTL(FPNUM,PRIEN)
E D
.S IENS=$P(PRIEN,U,1)
.S REASON=$P(PRIEN,U,3),CMMT=$P(PRIEN,U,4)
.S ZN=$G(^AUPNPROB(IENS,0)),RET=""
.Q:ZN=""
.S FPIEN=$$FNDFP(IENS,.FPNUM)
.S FNUM=$$FNUM
.S IEN2=IENS_","
.S FDA=$NA(FDA(FNUM,IEN2))
.S @FDA@(.12)="D"
.S @FDA@(2.01)=DUZ
.S @FDA@(2.02)=$$NOW^XLFDT()
.S @FDA@(2.03)=REASON
.S @FDA@(2.04)=CMMT
.S RET=$$UPDATE^BGOUTL(.FDA,,.IEN)
.;S RET=$$DELETE^BGOUTL("^AUPNPROB(",PRIEN)
.I 'RET D EVT^BGOPROB(IENS,2,ZN)
.I 'RET,FPIEN S RET=$$DELETE^BGOUTL(FPNUM,FPIEN)
Q
FNDFP(PRIEN,FNUM) ;EP-
N DFN,CLASS,DIEN,NIEN,DMOD,GBL,IEN,RET,X
S X=$G(^AUPNPROB(PRIEN,0)),DIEN=+X,DFN=$P(X,U,2),DMOD=$P(X,U,3),CLASS=$P(X,U,4),NIEN=$P(X,U,5)
S FNUM=$S(CLASS="P":9000013,1:0)
Q:'FNUM ""
S GBL=$$ROOT^DILFD(FNUM,,1)
Q:'$L(GBL) "" ;P8
S IEN=0,RET=""
F S IEN=$O(@GBL@("AC",DFN,IEN)) Q:'IEN D Q:RET
.S X=$G(@GBL@(IEN,0))
.I +X=DIEN,$P(X,U,2)=DFN,$P(X,U,3)\1=DMOD,$P(X,U,4)=NIEN S RET=IEN
Q RET
ASTHMA(RET,VIEN,INP,DIEN,DESCT) ;ASTHMA DATA
N ACL,ASTHMA,RET2,AIEN,CONTROL,RET3,INP2,IENS,CODE
K FDA
S FNUM=$$FNUM,RET2=""
S IENS=PRIEN_","
S FDA=$NA(FDA(FNUM,IENS))
Q:'DFN
Q:'PRIEN
S ACL=$P(INP,U,2)
Q:ACL=""
I DUZ("AG")="I" D
. S CODE=$$CODEC^ICDEX(80,DIEN)
. S ASTHMA=$$CHECK^BGOASLK(CODE,DESCT)
. I ASTHMA=0 S @FDA@(.15)="@"
. I ASTHMA=1 D
..S ACL=$S(ACL="INTERMITTENT":1,ACL="MILD PERSISTENT":2,ACL="MODERATE PERSISTENT":3,ACL="SEVERE PERSISTENT":4,1:"")
..S @FDA@(.15)=ACL
..S RET2=$$UPDATE^BGOUTL(.FDA,,.IENS)
..I RET2 S ERR=1,RET=RET_U_"Error on Asthma Update"
..;Patch 6 check to see if its an asthma diagnosis
..I ASTHMA=1&(ACL="") S RET=RET_U_ASTHMA
..S CONTROL=$P(INP,U,3)
..S AIEN=$P(INP,U,4)
..I VIEN="" S ERR=1,RET=RET_U_"Visit not defined. Cannot store asthma data"
..I CONTROL="NONE RECORDED" S CONTROL=""
..I CONTROL'="" D
...S INP2=AIEN_U_VIEN_U_CONTROL
...D SET^BGOVAST(.RET3,INP2)
...I RET3 S RET=RET_U_RET3
...E S RET=RET_U_"Unable to store V asthma data"
Q
; Return file number
FNUM() Q 9000011
BGOPROB3 ; IHS/BAO/TMD - Delete PROBLEMS ;11-Aug-2017 11:10;DU
+1 ;;1.1;BGO COMPONENTS;*20,23**;Mar 20, 2007;Build 3
+2 ; Delete a problem entry
+3 ; PRIEN = Problem IEN ^ TYPE ^ DELETE REASON ^ OTHER^PROB ID
DEL(RET,PRIEN) ;EP
+1 NEW FPIEN,FPNUM,ZN,REASON,CMMT,IENS,IEN2,FDA
+2 DO CHK^BGOPROB2(.RET,PRIEN)
+3 IF +RET<0
QUIT
+4 IF $PIECE(PRIEN,U,2)="P"&(+$PIECE(PRIEN,U,5)>8999)
Begin DoDot:1
+5 SET PRIEN=$PIECE(PRIEN,U,1)
+6 SET FPNUM=9000013
+7 SET RET=$$DELETE^BGOUTL(FPNUM,PRIEN)
End DoDot:1
+8 IF '$TEST
Begin DoDot:1
+9 SET IENS=$PIECE(PRIEN,U,1)
+10 SET REASON=$PIECE(PRIEN,U,3)
SET CMMT=$PIECE(PRIEN,U,4)
+11 SET ZN=$GET(^AUPNPROB(IENS,0))
SET RET=""
+12 IF ZN=""
QUIT
+13 SET FPIEN=$$FNDFP(IENS,.FPNUM)
+14 SET FNUM=$$FNUM
+15 SET IEN2=IENS_","
+16 SET FDA=$NAME(FDA(FNUM,IEN2))
+17 SET @FDA@(.12)="D"
+18 SET @FDA@(2.01)=DUZ
+19 SET @FDA@(2.02)=$$NOW^XLFDT()
+20 SET @FDA@(2.03)=REASON
+21 SET @FDA@(2.04)=CMMT
+22 SET RET=$$UPDATE^BGOUTL(.FDA,,.IEN)
+23 ;S RET=$$DELETE^BGOUTL("^AUPNPROB(",PRIEN)
+24 IF 'RET
DO EVT^BGOPROB(IENS,2,ZN)
+25 IF 'RET
IF FPIEN
SET RET=$$DELETE^BGOUTL(FPNUM,FPIEN)
End DoDot:1
+26 QUIT
FNDFP(PRIEN,FNUM) ;EP-
+1 NEW DFN,CLASS,DIEN,NIEN,DMOD,GBL,IEN,RET,X
+2 SET X=$GET(^AUPNPROB(PRIEN,0))
SET DIEN=+X
SET DFN=$PIECE(X,U,2)
SET DMOD=$PIECE(X,U,3)
SET CLASS=$PIECE(X,U,4)
SET NIEN=$PIECE(X,U,5)
+3 SET FNUM=$SELECT(CLASS="P":9000013,1:0)
+4 IF 'FNUM
QUIT ""
+5 SET GBL=$$ROOT^DILFD(FNUM,,1)
+6 ;P8
IF '$LENGTH(GBL)
QUIT ""
+7 SET IEN=0
SET RET=""
+8 FOR
SET IEN=$ORDER(@GBL@("AC",DFN,IEN))
IF 'IEN
QUIT
Begin DoDot:1
+9 SET X=$GET(@GBL@(IEN,0))
+10 IF +X=DIEN
IF $PIECE(X,U,2)=DFN
IF $PIECE(X,U,3)\1=DMOD
IF $PIECE(X,U,4)=NIEN
SET RET=IEN
End DoDot:1
IF RET
QUIT
+11 QUIT RET
ASTHMA(RET,VIEN,INP,DIEN,DESCT) ;ASTHMA DATA
+1 NEW ACL,ASTHMA,RET2,AIEN,CONTROL,RET3,INP2,IENS,CODE
+2 KILL FDA
+3 SET FNUM=$$FNUM
SET RET2=""
+4 SET IENS=PRIEN_","
+5 SET FDA=$NAME(FDA(FNUM,IENS))
+6 IF 'DFN
QUIT
+7 IF 'PRIEN
QUIT
+8 SET ACL=$PIECE(INP,U,2)
+9 IF ACL=""
QUIT
+10 IF DUZ("AG")="I"
Begin DoDot:1
+11 SET CODE=$$CODEC^ICDEX(80,DIEN)
+12 SET ASTHMA=$$CHECK^BGOASLK(CODE,DESCT)
+13 IF ASTHMA=0
SET @FDA@(.15)="@"
+14 IF ASTHMA=1
Begin DoDot:2
+15 SET ACL=$SELECT(ACL="INTERMITTENT":1,ACL="MILD PERSISTENT":2,ACL="MODERATE PERSISTENT":3,ACL="SEVERE PERSISTENT":4,1:"")
+16 SET @FDA@(.15)=ACL
+17 SET RET2=$$UPDATE^BGOUTL(.FDA,,.IENS)
+18 IF RET2
SET ERR=1
SET RET=RET_U_"Error on Asthma Update"
+19 ;Patch 6 check to see if its an asthma diagnosis
+20 IF ASTHMA=1&(ACL="")
SET RET=RET_U_ASTHMA
+21 SET CONTROL=$PIECE(INP,U,3)
+22 SET AIEN=$PIECE(INP,U,4)
+23 IF VIEN=""
SET ERR=1
SET RET=RET_U_"Visit not defined. Cannot store asthma data"
+24 IF CONTROL="NONE RECORDED"
SET CONTROL=""
+25 IF CONTROL'=""
Begin DoDot:3
+26 SET INP2=AIEN_U_VIEN_U_CONTROL
+27 DO SET^BGOVAST(.RET3,INP2)
+28 IF RET3
SET RET=RET_U_RET3
+29 IF '$TEST
SET RET=RET_U_"Unable to store V asthma data"
End DoDot:3
End DoDot:2
End DoDot:1
+30 QUIT
+31 ; Return file number
FNUM() QUIT 9000011
