- BDGICF1 ; IHS/ANMC/LJF - DEFICIENCY WORKSHEETS ;
- ;;5.3;PIMS;**1003,1005**;MAY 28, 2004
- ;IHS/ITSC/LJF 05/13/2005 PATCH 1003 add screen to patient lookup
- ;IHS/OIT/LJF 02/16/2006 PATCH 1005 mark as delinquent chart
- ; added coding date & who coded
- ; added deficiency comments
- ; 02/24/2006 PATCH 1005 fixed code to include observations
- ;
- ;
- NEW BDGT,PROMPT,BDGPAT
- ;IHS/OIT/LJF 02/24/2006 PATCH 1005
- ;S BDGT=$$READ^BDGF("SO^1:Inpatients;2:Day Surgeries;3:Both","Select Records to Print") Q:'BDGT
- S BDGT=$$READ^BDGF("SO^1:Inpatients/Observations;2:Day Surgeries;3:Both","Select Records to Print") Q:'BDGT
- ;IHS/ITSC/LJF 5/13/2005 PATCH 1003 screen patient lookup based on previous question
- NEW SCREEN S SCREEN=""
- ;I BDGT=1 S SCREEN="I $$GET1^DIQ(9009016.1,+Y,.0392)=""HOSPITALIZATION"""
- I BDGT=1 S SCREEN="I $$GET1^DIQ(9009016.1,+Y,.0392)'=""DAY SURGERY""" ;IHS/OIT/LJF 02/24/2006 PATCH 1005
- I BDGT=2 S SCREEN="I $$GET1^DIQ(9009016.1,+Y,.0392)=""DAY SURGERY"""
- ;
- K BDGPAT S Y=1 F D Q:Y<1
- . S PROMPT="Select "_$S($D(BDGPAT):"Another ",1:"")_"PATIENT Record"
- . ;
- . ;IHS/ITSC/LJF 5/13/2005 PATCH 1003 add screen to patient lookup
- . ;S Y=+$$READ^BDGF("PO^9009016.1:EQMZ",PROMPT) I Y>0 S BDGPAT(Y)=""
- . S Y=+$$READ^BDGF("PO^9009016.1:EQMZ",PROMPT,"","",SCREEN) I Y>0 S BDGPAT(Y)=""
- Q:'$D(BDGPAT)
- ;IHS/ITSC/LJF PATCH 1003 end of changes
- ;
- D ZIS^BDGF("PQ","PRINT^BDGICF1","DEFICIENCY WORKSHEETS","BDGT;BDGPAT(")
- Q
- ;
- ;
- PRINT ;EP; entry point to print
- U IO
- ;
- ;IHS/OIT/LJF 02/16/2006 PATCH 1005 set delinquent date
- NEW BDGDELQ S BDGDELQ=$$FMADD^XLFDT(DT,-$$GET1^DIQ(9009020.1,$$DIV^BSDU,.12))
- ;
- NEW IEN
- S IEN=0 F S IEN=$O(BDGPAT(IEN)) Q:'IEN D
- . I $$GET1^DIQ(9009016.1,IEN,.14)]"" Q ;not incomplete
- . I '$O(^BDGIC(IEN,1,0)) Q ;no deficiencies added yet
- . I BDGT=1 Q:$$GET1^DIQ(9009016.1,IEN,.02)="" ;not inpt
- . I BDGT=2 Q:$$GET1^DIQ(9009016.1,IEN,.05)="" ;not day surgery
- . D ONE
- ;
- D ^%ZISC
- Q
- ;
- ONE ; print one worksheet
- ;IHS/OIT/LJF 02/16/2006 PATCH 1005 reworte subroutine to mark as delinquent,
- ; add coding status and deficiency comments
- NEW DFN,TYPE,PRV,PRVN,FIRST,ARRAY,DATE,X
- S DFN=+$G(^BDGIC(IEN,0)) Q:'DFN
- S TYPE=$$GET1^DIQ(9009016.1,IEN,.0392)
- S DATE=$$GET1^DIQ(9009016.1,IEN,$S(TYPE["HOS":.02,TYPE["DAY":.05,1:.02),"I")
- I DATE<BDGDELQ W !!,?19,"DEFICIENCY WORKSHEET **DELINQUENT CHART**"
- E W !!,?30,"DEFICIENCY WORKSHEET"
- ;
- ;IHS/OIT/LJF 02/24/2006 PATCH 1005
- W !?(80-$L(TYPE)/2),TYPE
- ;W !!!,"Chart #: ",$$HRCND^BDGF2($$HRCN^BDGF2(DFN,DUZ(2)))
- ;W ?20,$S(TYPE="HOSPITALIZATION":"Discharged on ",1:"Surgery on ")
- ;W $P($$GET1^DIQ(9009016.1,IEN,$S(TYPE["HOS":".02",1:".05")),"@")
- W !!,"Chart #: ",$$HRCND^BDGF2($$HRCN^BDGF2(DFN,DUZ(2)))
- W ?20,$S(TYPE="DAY SURGERY":"Surgery on ",1:"Discharged on ")
- W $P($$GET1^DIQ(9009016.1,IEN,$S(TYPE["DAY":".05",1:".02")),"@")
- ;
- W ?50,"Date Printed: ",$$FMTE^XLFDT(DT),!
- ;
- ; coding status and who coded
- S X=$$GET1^DIQ(9009016.1,IEN,.13)
- I X]"" W !,"Chart Coded On: ",X," by ",$$GET1^DIQ(9009016.1,IEN,.22),!
- ;
- ; find all deficiencies by provider
- S PRV=0 F S PRV=$O(^BDGIC(IEN,1,"B",PRV)) Q:'PRV D
- . S PRVN=0 F S PRVN=$O(^BDGIC(IEN,1,"B",PRV,PRVN)) Q:'PRVN D
- .. Q:$$GET1^DIQ(9009016.11,PRVN_","_IEN,.03)]"" ;resolved
- .. Q:$$GET1^DIQ(9009016.11,PRVN_","_IEN,.04)]"" ;deleted
- .. S ARRAY($$GET1^DIQ(200,PRV,.01),PRVN)="" ;put in alpha order
- ;
- S FIRST=1,NAME=0 F S NAME=$O(ARRAY(NAME)) Q:NAME="" D
- . S PRV=0 F S PRV=$O(ARRAY(NAME,PRV)) Q:'PRV D
- .. I FIRST W !!,NAME,?35
- .. W $$GET1^DIQ(9009016.11,PRV_","_IEN,.02) ;deficiency name
- .. S X=$$GET1^DIQ(9009016.11,PRV_","_IEN,.06) I X]"" W !,?40,X ;comments
- .. W !,?35
- ;
- W @IOF
- Q
- ;
- BDGICF1 ; IHS/ANMC/LJF - DEFICIENCY WORKSHEETS ;
- +1 ;;5.3;PIMS;**1003,1005**;MAY 28, 2004
- +2 ;IHS/ITSC/LJF 05/13/2005 PATCH 1003 add screen to patient lookup
- +3 ;IHS/OIT/LJF 02/16/2006 PATCH 1005 mark as delinquent chart
- +4 ; added coding date & who coded
- +5 ; added deficiency comments
- +6 ; 02/24/2006 PATCH 1005 fixed code to include observations
- +7 ;
- +8 ;
- +9 NEW BDGT,PROMPT,BDGPAT
- +10 ;IHS/OIT/LJF 02/24/2006 PATCH 1005
- +11 ;S BDGT=$$READ^BDGF("SO^1:Inpatients;2:Day Surgeries;3:Both","Select Records to Print") Q:'BDGT
- +12 SET BDGT=$$READ^BDGF("SO^1:Inpatients/Observations;2:Day Surgeries;3:Both","Select Records to Print")
- IF 'BDGT
- QUIT
- +13 ;IHS/ITSC/LJF 5/13/2005 PATCH 1003 screen patient lookup based on previous question
- +14 NEW SCREEN
- SET SCREEN=""
- +15 ;I BDGT=1 S SCREEN="I $$GET1^DIQ(9009016.1,+Y,.0392)=""HOSPITALIZATION"""
- +16 ;IHS/OIT/LJF 02/24/2006 PATCH 1005
- IF BDGT=1
- SET SCREEN="I $$GET1^DIQ(9009016.1,+Y,.0392)'=""DAY SURGERY"""
- +17 IF BDGT=2
- SET SCREEN="I $$GET1^DIQ(9009016.1,+Y,.0392)=""DAY SURGERY"""
- +18 ;
- +19 KILL BDGPAT
- SET Y=1
- FOR
- Begin DoDot:1
- +20 SET PROMPT="Select "_$SELECT($DATA(BDGPAT):"Another ",1:"")_"PATIENT Record"
- +21 ;
- +22 ;IHS/ITSC/LJF 5/13/2005 PATCH 1003 add screen to patient lookup
- +23 ;S Y=+$$READ^BDGF("PO^9009016.1:EQMZ",PROMPT) I Y>0 S BDGPAT(Y)=""
- +24 SET Y=+$$READ^BDGF("PO^9009016.1:EQMZ",PROMPT,"","",SCREEN)
- IF Y>0
- SET BDGPAT(Y)=""
- End DoDot:1
- IF Y<1
- QUIT
- +25 IF '$DATA(BDGPAT)
- QUIT
- +26 ;IHS/ITSC/LJF PATCH 1003 end of changes
- +27 ;
- +28 DO ZIS^BDGF("PQ","PRINT^BDGICF1","DEFICIENCY WORKSHEETS","BDGT;BDGPAT(")
- +29 QUIT
- +30 ;
- +31 ;
- PRINT ;EP; entry point to print
- +1 USE IO
- +2 ;
- +3 ;IHS/OIT/LJF 02/16/2006 PATCH 1005 set delinquent date
- +4 NEW BDGDELQ
- SET BDGDELQ=$$FMADD^XLFDT(DT,-$$GET1^DIQ(9009020.1,$$DIV^BSDU,.12))
- +5 ;
- +6 NEW IEN
- +7 SET IEN=0
- FOR
- SET IEN=$ORDER(BDGPAT(IEN))
- IF 'IEN
- QUIT
- Begin DoDot:1
- +8 ;not incomplete
- IF $$GET1^DIQ(9009016.1,IEN,.14)]""
- QUIT
- +9 ;no deficiencies added yet
- IF '$ORDER(^BDGIC(IEN,1,0))
- QUIT
- +10 ;not inpt
- IF BDGT=1
- IF $$GET1^DIQ(9009016.1,IEN,.02)=""
- QUIT
- +11 ;not day surgery
- IF BDGT=2
- IF $$GET1^DIQ(9009016.1,IEN,.05)=""
- QUIT
- +12 DO ONE
- End DoDot:1
- +13 ;
- +14 DO ^%ZISC
- +15 QUIT
- +16 ;
- ONE ; print one worksheet
- +1 ;IHS/OIT/LJF 02/16/2006 PATCH 1005 reworte subroutine to mark as delinquent,
- +2 ; add coding status and deficiency comments
- +3 NEW DFN,TYPE,PRV,PRVN,FIRST,ARRAY,DATE,X
- +4 SET DFN=+$GET(^BDGIC(IEN,0))
- IF 'DFN
- QUIT
- +5 SET TYPE=$$GET1^DIQ(9009016.1,IEN,.0392)
- +6 SET DATE=$$GET1^DIQ(9009016.1,IEN,$SELECT(TYPE["HOS":.02,TYPE["DAY":.05,1:.02),"I")
- +7 IF DATE<BDGDELQ
- WRITE !!,?19,"DEFICIENCY WORKSHEET **DELINQUENT CHART**"
- +8 IF '$TEST
- WRITE !!,?30,"DEFICIENCY WORKSHEET"
- +9 ;
- +10 ;IHS/OIT/LJF 02/24/2006 PATCH 1005
- +11 WRITE !?(80-$LENGTH(TYPE)/2),TYPE
- +12 ;W !!!,"Chart #: ",$$HRCND^BDGF2($$HRCN^BDGF2(DFN,DUZ(2)))
- +13 ;W ?20,$S(TYPE="HOSPITALIZATION":"Discharged on ",1:"Surgery on ")
- +14 ;W $P($$GET1^DIQ(9009016.1,IEN,$S(TYPE["HOS":".02",1:".05")),"@")
- +15 WRITE !!,"Chart #: ",$$HRCND^BDGF2($$HRCN^BDGF2(DFN,DUZ(2)))
- +16 WRITE ?20,$SELECT(TYPE="DAY SURGERY":"Surgery on ",1:"Discharged on ")
- +17 WRITE $PIECE($$GET1^DIQ(9009016.1,IEN,$SELECT(TYPE["DAY":".05",1:".02")),"@")
- +18 ;
- +19 WRITE ?50,"Date Printed: ",$$FMTE^XLFDT(DT),!
- +20 ;
- +21 ; coding status and who coded
- +22 SET X=$$GET1^DIQ(9009016.1,IEN,.13)
- +23 IF X]""
- WRITE !,"Chart Coded On: ",X," by ",$$GET1^DIQ(9009016.1,IEN,.22),!
- +24 ;
- +25 ; find all deficiencies by provider
- +26 SET PRV=0
- FOR
- SET PRV=$ORDER(^BDGIC(IEN,1,"B",PRV))
- IF 'PRV
- QUIT
- Begin DoDot:1
- +27 SET PRVN=0
- FOR
- SET PRVN=$ORDER(^BDGIC(IEN,1,"B",PRV,PRVN))
- IF 'PRVN
- QUIT
- Begin DoDot:2
- +28 ;resolved
- IF $$GET1^DIQ(9009016.11,PRVN_","_IEN,.03)]""
- QUIT
- +29 ;deleted
- IF $$GET1^DIQ(9009016.11,PRVN_","_IEN,.04)]""
- QUIT
- +30 ;put in alpha order
- SET ARRAY($$GET1^DIQ(200,PRV,.01),PRVN)=""
- End DoDot:2
- End DoDot:1
- +31 ;
- +32 SET FIRST=1
- SET NAME=0
- FOR
- SET NAME=$ORDER(ARRAY(NAME))
- IF NAME=""
- QUIT
- Begin DoDot:1
- +33 SET PRV=0
- FOR
- SET PRV=$ORDER(ARRAY(NAME,PRV))
- IF 'PRV
- QUIT
- Begin DoDot:2
- +34 IF FIRST
- WRITE !!,NAME,?35
- +35 ;deficiency name
- WRITE $$GET1^DIQ(9009016.11,PRV_","_IEN,.02)
- +36 ;comments
- SET X=$$GET1^DIQ(9009016.11,PRV_","_IEN,.06)
- IF X]""
- WRITE !,?40,X
- +37 WRITE !,?35
- End DoDot:2
- End DoDot:1
- +38 ;
- +39 WRITE @IOF
- +40 QUIT
- +41 ;
