- 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
