- BQIIPDXC ;GDIT/HS/ALA-Search for diagnosis ; 20 Nov 2014 3:52 PM
- ;;2.3;ICARE MANAGEMENT SYSTEM;**5**;Apr 18, 2012;Build 17
- ;
- DX(TMFRAME,BQDFN,DXC,START,END) ;EP
- ; Find visits for a diagnostic code
- ; Input
- ; TMFRAME - Time frame to search data for
- ; BQDFN - Patient internal entry number
- ; DXC - Diagnostic code
- ; START - Starting Date
- ; END - Ending Date
- ;
- NEW DXN,FREF,GREF,ENDT,IEN,QFL,RESULT,VISIT,VSDTM
- S TMFRAME=$G(TMFRAME,""),START=$G(START,""),END=$G(END,"")
- S FREF=9000010.07,GREF=$$ROOT^DILFD(FREF,"",1)
- I $G(TMFRAME)'="" S ENDT=$$DATE^BQIUL1(TMFRAME),BDT=""
- I $G(START)'="" S ENDT=START,BDT=(9999999-END)-.001
- I $$VERSION^XPDUTL("AICD")<4.0 D
- . S DXN=$$FIND1^DIC(80,"","Q",DXC,"BA","","ERROR")
- I $$VERSION^XPDUTL("AICD")>3.51 D
- . S DXN=$P($$CODEN^ICDEX(DXC,80),"~",1)
- ;
- S IEN="",QFL=0,RESULT=0
- ;
- D
- . I $G(TMFRAME)="",$G(START)="",$G(END)="" Q
- . S EDT=9999999-ENDT
- . F S BDT=$O(@GREF@("AA",BQDFN,BDT)) Q:BDT=""!(BDT>EDT) D
- .. S IEN=""
- .. F S IEN=$O(@GREF@("AA",BQDFN,BDT,IEN)) Q:IEN="" D
- ... S TIEN=$$GET1^DIQ(FREF,IEN,.01,"I") I TIEN="" Q
- ... I TIEN'=DXN Q
- ... S VISIT=$$GET1^DIQ(FREF,IEN,.03,"I") I VISIT="" Q
- ... I $$GET1^DIQ(9000010,VISIT,.11,"I")=1 Q
- ... S VSDTM=$$GET1^DIQ(9000010,VISIT,.01,"I")\1 Q:VSDTM=0
- ... S RESULT=1_U_VSDTM_U_U_VISIT_U_IEN,QFL=1
- ;
- I $G(TMFRAME)="" D
- . F S IEN=$O(@GREF@("AC",BQDFN,IEN),-1) Q:'IEN D Q:QFL
- .. S TIEN=$$GET1^DIQ(FREF,IEN,.01,"I") I TIEN="" Q
- .. I TIEN'=DXN Q
- .. S VISIT=$$GET1^DIQ(FREF,IEN,.03,"I") I VISIT="" Q
- .. I $$GET1^DIQ(9000010,VISIT,.11,"I")=1 Q
- .. S VSDTM=$$GET1^DIQ(9000010,VISIT,.01,"I")\1 Q:VSDTM=0
- .. S RESULT=1_U_VSDTM_U_U_VISIT_U_IEN,QFL=1
- Q RESULT
- BQIIPDXC ;GDIT/HS/ALA-Search for diagnosis ; 20 Nov 2014 3:52 PM
- +1 ;;2.3;ICARE MANAGEMENT SYSTEM;**5**;Apr 18, 2012;Build 17
- +2 ;
- DX(TMFRAME,BQDFN,DXC,START,END) ;EP
- +1 ; Find visits for a diagnostic code
- +2 ; Input
- +3 ; TMFRAME - Time frame to search data for
- +4 ; BQDFN - Patient internal entry number
- +5 ; DXC - Diagnostic code
- +6 ; START - Starting Date
- +7 ; END - Ending Date
- +8 ;
- +9 NEW DXN,FREF,GREF,ENDT,IEN,QFL,RESULT,VISIT,VSDTM
- +10 SET TMFRAME=$GET(TMFRAME,"")
- SET START=$GET(START,"")
- SET END=$GET(END,"")
- +11 SET FREF=9000010.07
- SET GREF=$$ROOT^DILFD(FREF,"",1)
- +12 IF $GET(TMFRAME)'=""
- SET ENDT=$$DATE^BQIUL1(TMFRAME)
- SET BDT=""
- +13 IF $GET(START)'=""
- SET ENDT=START
- SET BDT=(9999999-END)-.001
- +14 IF $$VERSION^XPDUTL("AICD")<4.0
- Begin DoDot:1
- +15 SET DXN=$$FIND1^DIC(80,"","Q",DXC,"BA","","ERROR")
- End DoDot:1
- +16 IF $$VERSION^XPDUTL("AICD")>3.51
- Begin DoDot:1
- +17 SET DXN=$PIECE($$CODEN^ICDEX(DXC,80),"~",1)
- End DoDot:1
- +18 ;
- +19 SET IEN=""
- SET QFL=0
- SET RESULT=0
- +20 ;
- +21 Begin DoDot:1
- +22 IF $GET(TMFRAME)=""
- IF $GET(START)=""
- IF $GET(END)=""
- QUIT
- +23 SET EDT=9999999-ENDT
- +24 FOR
- SET BDT=$ORDER(@GREF@("AA",BQDFN,BDT))
- IF BDT=""!(BDT>EDT)
- QUIT
- Begin DoDot:2
- +25 SET IEN=""
- +26 FOR
- SET IEN=$ORDER(@GREF@("AA",BQDFN,BDT,IEN))
- IF IEN=""
- QUIT
- Begin DoDot:3
- +27 SET TIEN=$$GET1^DIQ(FREF,IEN,.01,"I")
- IF TIEN=""
- QUIT
- +28 IF TIEN'=DXN
- QUIT
- +29 SET VISIT=$$GET1^DIQ(FREF,IEN,.03,"I")
- IF VISIT=""
- QUIT
- +30 IF $$GET1^DIQ(9000010,VISIT,.11,"I")=1
- QUIT
- +31 SET VSDTM=$$GET1^DIQ(9000010,VISIT,.01,"I")\1
- IF VSDTM=0
- QUIT
- +32 SET RESULT=1_U_VSDTM_U_U_VISIT_U_IEN
- SET QFL=1
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +33 ;
- +34 IF $GET(TMFRAME)=""
- Begin DoDot:1
- +35 FOR
- SET IEN=$ORDER(@GREF@("AC",BQDFN,IEN),-1)
- IF 'IEN
- QUIT
- Begin DoDot:2
- +36 SET TIEN=$$GET1^DIQ(FREF,IEN,.01,"I")
- IF TIEN=""
- QUIT
- +37 IF TIEN'=DXN
- QUIT
- +38 SET VISIT=$$GET1^DIQ(FREF,IEN,.03,"I")
- IF VISIT=""
- QUIT
- +39 IF $$GET1^DIQ(9000010,VISIT,.11,"I")=1
- QUIT
- +40 SET VSDTM=$$GET1^DIQ(9000010,VISIT,.01,"I")\1
- IF VSDTM=0
- QUIT
- +41 SET RESULT=1_U_VSDTM_U_U_VISIT_U_IEN
- SET QFL=1
- End DoDot:2
- IF QFL
- QUIT
- End DoDot:1
- +42 QUIT RESULT