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 ;
