BTIUICL ; IHS/ITSC/LJF - AWAITING SIGNATURES REPORT ;
;;1.0;TEXT INTEGRATION UTILITIES;;NOV 04, 2004
;Requires PIMS version 5.3
;
EN ; -- main entry point for BTIU IC LISTING option
D ^XBCLS D MSG^BTIUU($$SP(20)_"Awaiting Signature Listing",2,2,0)
I '$L($T(^BDGF1)) D MSG^BTIUU("** Sorry, you must have ADT version 5.3 to run this report! **",2,2,0),PAUSE^BTIUU Q
;
NEW TIUPROV S TIUPROV=+$$PROV Q:'TIUPROV
NEW VALMCNT
D TERM^VALM0
D EN^VALM("BTIU IC SIG STATUS")
Q
;
HDR ; -- header code
Q
;
INIT ; -- init variables and list array
NEW TIULN
D GATHER(TIUPROV)
S VALMCNT=TIULN
Q
;
HELP ; -- help code
S X="?" D DISP^XQORM1 W !!
Q
;
EXIT ; -- exit code
K VALMCNT
K ^TMP("BTIUICL",$J)
Q
;
EXPND ; -- expand code
Q
;
GATHER(PROV) ; -- create display array
NEW X,TIUCNT,TIUCD,IEN,IEN2,CD,DATE,DATE2,LINE,TIUN,DFN
D MSG^BTIUU("Building/Updating Display. . .Please wait.",2,0,0)
K ^TMP("BTIUICL",$J)
S (TIUCNT,TIULN)=0
S IEN=0 F S IEN=$O(^BDGIC("APRV",PROV,IEN)) Q:'IEN D
. Q:$$GET1^DIQ(9009016.1,IEN,.17)]"" ;deleted entry
. S IEN2=0 F S IEN2=$O(^BDGIC("APRV",PROV,IEN,IEN2)) Q:'IEN2 D
.. S CD=$P($G(^BDGIC(IEN,1,IEN2,0)),U,2) Q:'CD
.. S DFN=$$GET1^DIQ(9009016.1,IEN,.01,"I") ;patient ien
.. Q:'$$SIG(CD) ;deficiency not on list
.. S DATE=$$GET1^DIQ(9009016.1,IEN,.02,"I") ;discharge date
.. S DATE2=$$GET1^DIQ(9009016.1,IEN,.05,"I") ;surgery date
.. I DATE S LINE=$$DATA(DFN,IEN,PROV,CD,DATE,0,.TIUN) ;inpt line
.. I DATE2 S LINE=$$DATA(DFN,IEN,PROV,CD,DATE2,1,.TIUN) ;ds line
.. ;
.. ;code for partial entries
.. I 'DATE,'DATE2 D ;if dates are missing
... S X=$$GET1^DIQ(9009016.1,IEN,.03,"I") ;visit pointer
... S X=$$GET1^DIQ(9000010,+X,.01,"I") ;visit date
... S LINE=$$DATA(DFN,IEN,PROV,CD,X,2,.TIUN)
.. ;
.. D SET(LINE,TIUCNT,IEN,$G(TIUN)) ;put line into array
;
Q
;
SIG(CD) ; -- returns 1 if chart deficiency on list for report
I '$D(TIUCD) D CDSET
I $D(TIUCD(CD)) Q 1
Q 0
;
CDSET ; -- returns TIUCD array with deficiencies linked to tiu
NEW X,Y
S X=0 F S X=$O(^BDGCD(X)) Q:'X D
. S Y=$P($G(^BDGCD(X,"TIU")),U)
. I Y S TIUCD(X)=Y
Q
;
DATA(DFN,IEN,PROV,CD,DATE,DAY,TIUN) ; -- returns display line
NEW X,LINE
S TIUCNT=TIUCNT+1,LINE=$J(TIUCNT,3)
S LINE=$$PAD(LINE,5)_$$PAD($E($$GET1^DIQ(200,PROV,.01),1,15),17)
S LINE=LINE_$$PAD($$PAT(DFN),18)
S LINE=LINE_$$PAD($J($$FMTE^XLFDT(DATE,"2D"),8),10)
S LINE=LINE_$$PAD($E($$GET1^DIQ(9009016.4,CD,.01),1,10),12)
;
;code for partial entries
I DAY=1 S LINE=LINE_"DS-" ;day surgery entry
I DAY=2 S LINE=LINE_"??-" ;unknown type
;
S LINE=LINE_$$DOCSTAT(CD,DFN,IEN,DATE,DAY,.TIUN)
Q LINE
;
PAT(DFN) ; -- returns patient chart # and last name
NEW X,Y
S X=$P($G(^AUPNPAT(DFN,41,DUZ(2),0)),U,2)
S Y=$P($P($G(^DPT(DFN,0)),U),",")
Q $J(X,7)_" "_Y
;
DOCSTAT(CD,DFN,IEN,DATE,DAY,TIUN) ; -- returns status of doc tied to deficiency
NEW CLASS,TIUST,VISIT,TIU,TYPE,TIUR,X,Y
S VISIT=$$GET1^DIQ(9009016.1,IEN,.03,"I") I 'VISIT Q "?? No visit"
S CLASS=TIUCD(CD) ;get doc class
;
; find all documents for visit and chart deficiency
S TIU=0 F S TIU=$O(^TIU(8925,"V",VISIT,TIU)) Q:'TIU D
. S TYPE=+$G(^TIU(8925,TIU,0)) Q:'$$CLASS(CLASS,TYPE,TIU)
. ;
. ; get document status
. K TIUR D ENP^XBDIQ1(8925,TIU,".05;1501;1507","TIUR(","I")
. S X=TIUR(.05),Y=""
. I X="COMPLETED" S Y=$S(TIUR(1507)]"":TIUR(1507,"I"),1:TIUR(1501,"I"))
. I Y]"" S Y=$$FMTE^XLFDT(Y,"2D")
. S TIUST=$G(TIUST)_X_" "_Y,TIUN=TIU
;
Q $S($D(TIUST):TIUST,1:"?? Not in TIU")
;
CLASS(CLASS,TYPE,TIU) ; -- returns 1 if doc is in corect doc class
I TYPE=CLASS Q 1
I $$GET1^DIQ(8925.1,TYPE,.01)="ADDENDUM" S TYPE=$$GET1^DIQ(8925,TIU,.04,"I")
I $$DOCCLASS^TIULC1(TYPE)=CLASS Q 1
Q 0
;
SET(LINE,COUNT,IEN,TIU) ; -- sets ^tmp
S TIULN=TIULN+1
S ^TMP("BTIUICL",$J,TIULN,0)=LINE
S ^TMP("BTIUICL",$J,"IDX",TIULN,COUNT)=IEN_U_TIU
Q
;
;
GETIC ; -- select item from list
NEW X,Y,Z,VALMY
D FULL^VALM1
S TIUICN=0
D EN^VALM2(XQORNOD(0),"OS")
I '$D(VALMY) Q
S X=$O(VALMY(0))
S Y=0 F S Y=$O(^TMP("BTIUICL",$J,"IDX",Y)) Q:Y="" Q:TIUICN>0 D
. S Z=$O(^TMP("BTIUICL",$J,"IDX",Y,0))
. Q:^TMP("BTIUICL",$J,"IDX",Y,Z)=""
. I Z=X S TIUICN=^TMP("BTIUICL",$J,"IDX",Y,Z)
Q
;
ICE ;EP; -- action to edit IC file
NEW TIUICN,DDSFILE,DA,DR,VSTYP,BDGN
D GETIC I 'TIUICN Q
S VSTYP=$$GET1^DIQ(9000010,+$$GET1^DIQ(9009016.1,+TIUICN,.03,"I"),.07,"I") ;visit service category
S DDSFILE=9009016.1,(DA,BDGN)=+TIUICN
S DR=$S(VSTYP="H":"[BDG INCOMPLETE EDIT]",1:"[BDG DAY SURGERY EDIT]")
D ^DDS
Q
;
ICP ;EP; -- action to print chart copy
NEW TIUICN
D GETIC Q:'TIUICN S TIUDA=$P(TIUICN,U,2) I TIUDA="" Q
D PRINT1^TIURA
Q
;
RESET ;EP; -- action to rebuild display
S TIUPROV=+$$PROV I TIUPROV<1 S VALMBCK="Q" Q
D TERM^VALM0 S VALMBCK="R"
D INIT,HDR Q
;
PAD(DATA,LENGTH) ; -- SUBRTN to pad length of data
Q $E(DATA_$$REPEAT^XLFSTR(" ",LENGTH),1,LENGTH)
;
SP(NUM) ; -- SUBRTN to pad spaces
Q $$PAD(" ",NUM)
;
PROV() ; -- ask for provider
NEW Y,SCREEN
S SCREEN="I $D(^XUSEC(""PROVIDER"",+Y))"
S Y=$$READ^TIUU("PO^200:EMQZ","Select PROVIDER NAME","","",SCREEN)
I Y<1 W !,"No provider selected" D RETURN^BTIUU Q 0
;
; does provider have incomplete charts?
I '$O(^BDGIC("APRV",+Y,0)) W !!,"Provider does NOT have any incomplete charts.",! D RETURN^BTIUU Q 0
Q +Y
BTIUICL ; IHS/ITSC/LJF - AWAITING SIGNATURES REPORT ;
+1 ;;1.0;TEXT INTEGRATION UTILITIES;;NOV 04, 2004
+2 ;Requires PIMS version 5.3
+3 ;
EN ; -- main entry point for BTIU IC LISTING option
+1 DO ^XBCLS
DO MSG^BTIUU($$SP(20)_"Awaiting Signature Listing",2,2,0)
+2 IF '$LENGTH($TEXT(^BDGF1))
DO MSG^BTIUU("** Sorry, you must have ADT version 5.3 to run this report! **",2,2,0)
DO PAUSE^BTIUU
QUIT
+3 ;
+4 NEW TIUPROV
SET TIUPROV=+$$PROV
IF 'TIUPROV
QUIT
+5 NEW VALMCNT
+6 DO TERM^VALM0
+7 DO EN^VALM("BTIU IC SIG STATUS")
+8 QUIT
+9 ;
HDR ; -- header code
+1 QUIT
+2 ;
INIT ; -- init variables and list array
+1 NEW TIULN
+2 DO GATHER(TIUPROV)
+3 SET VALMCNT=TIULN
+4 QUIT
+5 ;
HELP ; -- help code
+1 SET X="?"
DO DISP^XQORM1
WRITE !!
+2 QUIT
+3 ;
EXIT ; -- exit code
+1 KILL VALMCNT
+2 KILL ^TMP("BTIUICL",$JOB)
+3 QUIT
+4 ;
EXPND ; -- expand code
+1 QUIT
+2 ;
GATHER(PROV) ; -- create display array
+1 NEW X,TIUCNT,TIUCD,IEN,IEN2,CD,DATE,DATE2,LINE,TIUN,DFN
+2 DO MSG^BTIUU("Building/Updating Display. . .Please wait.",2,0,0)
+3 KILL ^TMP("BTIUICL",$JOB)
+4 SET (TIUCNT,TIULN)=0
+5 SET IEN=0
FOR
SET IEN=$ORDER(^BDGIC("APRV",PROV,IEN))
IF 'IEN
QUIT
Begin DoDot:1
+6 ;deleted entry
IF $$GET1^DIQ(9009016.1,IEN,.17)]""
QUIT
+7 SET IEN2=0
FOR
SET IEN2=$ORDER(^BDGIC("APRV",PROV,IEN,IEN2))
IF 'IEN2
QUIT
Begin DoDot:2
+8 SET CD=$PIECE($GET(^BDGIC(IEN,1,IEN2,0)),U,2)
IF 'CD
QUIT
+9 ;patient ien
SET DFN=$$GET1^DIQ(9009016.1,IEN,.01,"I")
+10 ;deficiency not on list
IF '$$SIG(CD)
QUIT
+11 ;discharge date
SET DATE=$$GET1^DIQ(9009016.1,IEN,.02,"I")
+12 ;surgery date
SET DATE2=$$GET1^DIQ(9009016.1,IEN,.05,"I")
+13 ;inpt line
IF DATE
SET LINE=$$DATA(DFN,IEN,PROV,CD,DATE,0,.TIUN)
+14 ;ds line
IF DATE2
SET LINE=$$DATA(DFN,IEN,PROV,CD,DATE2,1,.TIUN)
+15 ;
+16 ;code for partial entries
+17 ;if dates are missing
IF 'DATE
IF 'DATE2
Begin DoDot:3
+18 ;visit pointer
SET X=$$GET1^DIQ(9009016.1,IEN,.03,"I")
+19 ;visit date
SET X=$$GET1^DIQ(9000010,+X,.01,"I")
+20 SET LINE=$$DATA(DFN,IEN,PROV,CD,X,2,.TIUN)
End DoDot:3
+21 ;
+22 ;put line into array
DO SET(LINE,TIUCNT,IEN,$GET(TIUN))
End DoDot:2
End DoDot:1
+23 ;
+24 QUIT
+25 ;
SIG(CD) ; -- returns 1 if chart deficiency on list for report
+1 IF '$DATA(TIUCD)
DO CDSET
+2 IF $DATA(TIUCD(CD))
QUIT 1
+3 QUIT 0
+4 ;
CDSET ; -- returns TIUCD array with deficiencies linked to tiu
+1 NEW X,Y
+2 SET X=0
FOR
SET X=$ORDER(^BDGCD(X))
IF 'X
QUIT
Begin DoDot:1
+3 SET Y=$PIECE($GET(^BDGCD(X,"TIU")),U)
+4 IF Y
SET TIUCD(X)=Y
End DoDot:1
+5 QUIT
+6 ;
DATA(DFN,IEN,PROV,CD,DATE,DAY,TIUN) ; -- returns display line
+1 NEW X,LINE
+2 SET TIUCNT=TIUCNT+1
SET LINE=$JUSTIFY(TIUCNT,3)
+3 SET LINE=$$PAD(LINE,5)_$$PAD($EXTRACT($$GET1^DIQ(200,PROV,.01),1,15),17)
+4 SET LINE=LINE_$$PAD($$PAT(DFN),18)
+5 SET LINE=LINE_$$PAD($JUSTIFY($$FMTE^XLFDT(DATE,"2D"),8),10)
+6 SET LINE=LINE_$$PAD($EXTRACT($$GET1^DIQ(9009016.4,CD,.01),1,10),12)
+7 ;
+8 ;code for partial entries
+9 ;day surgery entry
IF DAY=1
SET LINE=LINE_"DS-"
+10 ;unknown type
IF DAY=2
SET LINE=LINE_"??-"
+11 ;
+12 SET LINE=LINE_$$DOCSTAT(CD,DFN,IEN,DATE,DAY,.TIUN)
+13 QUIT LINE
+14 ;
PAT(DFN) ; -- returns patient chart # and last name
+1 NEW X,Y
+2 SET X=$PIECE($GET(^AUPNPAT(DFN,41,DUZ(2),0)),U,2)
+3 SET Y=$PIECE($PIECE($GET(^DPT(DFN,0)),U),",")
+4 QUIT $JUSTIFY(X,7)_" "_Y
+5 ;
DOCSTAT(CD,DFN,IEN,DATE,DAY,TIUN) ; -- returns status of doc tied to deficiency
+1 NEW CLASS,TIUST,VISIT,TIU,TYPE,TIUR,X,Y
+2 SET VISIT=$$GET1^DIQ(9009016.1,IEN,.03,"I")
IF 'VISIT
QUIT "?? No visit"
+3 ;get doc class
SET CLASS=TIUCD(CD)
+4 ;
+5 ; find all documents for visit and chart deficiency
+6 SET TIU=0
FOR
SET TIU=$ORDER(^TIU(8925,"V",VISIT,TIU))
IF 'TIU
QUIT
Begin DoDot:1
+7 SET TYPE=+$GET(^TIU(8925,TIU,0))
IF '$$CLASS(CLASS,TYPE,TIU)
QUIT
+8 ;
+9 ; get document status
+10 KILL TIUR
DO ENP^XBDIQ1(8925,TIU,".05;1501;1507","TIUR(","I")
+11 SET X=TIUR(.05)
SET Y=""
+12 IF X="COMPLETED"
SET Y=$SELECT(TIUR(1507)]"":TIUR(1507,"I"),1:TIUR(1501,"I"))
+13 IF Y]""
SET Y=$$FMTE^XLFDT(Y,"2D")
+14 SET TIUST=$GET(TIUST)_X_" "_Y
SET TIUN=TIU
End DoDot:1
+15 ;
+16 QUIT $SELECT($DATA(TIUST):TIUST,1:"?? Not in TIU")
+17 ;
CLASS(CLASS,TYPE,TIU) ; -- returns 1 if doc is in corect doc class
+1 IF TYPE=CLASS
QUIT 1
+2 IF $$GET1^DIQ(8925.1,TYPE,.01)="ADDENDUM"
SET TYPE=$$GET1^DIQ(8925,TIU,.04,"I")
+3 IF $$DOCCLASS^TIULC1(TYPE)=CLASS
QUIT 1
+4 QUIT 0
+5 ;
SET(LINE,COUNT,IEN,TIU) ; -- sets ^tmp
+1 SET TIULN=TIULN+1
+2 SET ^TMP("BTIUICL",$JOB,TIULN,0)=LINE
+3 SET ^TMP("BTIUICL",$JOB,"IDX",TIULN,COUNT)=IEN_U_TIU
+4 QUIT
+5 ;
+6 ;
GETIC ; -- select item from list
+1 NEW X,Y,Z,VALMY
+2 DO FULL^VALM1
+3 SET TIUICN=0
+4 DO EN^VALM2(XQORNOD(0),"OS")
+5 IF '$DATA(VALMY)
QUIT
+6 SET X=$ORDER(VALMY(0))
+7 SET Y=0
FOR
SET Y=$ORDER(^TMP("BTIUICL",$JOB,"IDX",Y))
IF Y=""
QUIT
IF TIUICN>0
QUIT
Begin DoDot:1
+8 SET Z=$ORDER(^TMP("BTIUICL",$JOB,"IDX",Y,0))
+9 IF ^TMP("BTIUICL",$JOB,"IDX",Y,Z)=""
QUIT
+10 IF Z=X
SET TIUICN=^TMP("BTIUICL",$JOB,"IDX",Y,Z)
End DoDot:1
+11 QUIT
+12 ;
ICE ;EP; -- action to edit IC file
+1 NEW TIUICN,DDSFILE,DA,DR,VSTYP,BDGN
+2 DO GETIC
IF 'TIUICN
QUIT
+3 ;visit service category
SET VSTYP=$$GET1^DIQ(9000010,+$$GET1^DIQ(9009016.1,+TIUICN,.03,"I"),.07,"I")
+4 SET DDSFILE=9009016.1
SET (DA,BDGN)=+TIUICN
+5 SET DR=$SELECT(VSTYP="H":"[BDG INCOMPLETE EDIT]",1:"[BDG DAY SURGERY EDIT]")
+6 DO ^DDS
+7 QUIT
+8 ;
ICP ;EP; -- action to print chart copy
+1 NEW TIUICN
+2 DO GETIC
IF 'TIUICN
QUIT
SET TIUDA=$PIECE(TIUICN,U,2)
IF TIUDA=""
QUIT
+3 DO PRINT1^TIURA
+4 QUIT
+5 ;
RESET ;EP; -- action to rebuild display
+1 SET TIUPROV=+$$PROV
IF TIUPROV<1
SET VALMBCK="Q"
QUIT
+2 DO TERM^VALM0
SET VALMBCK="R"
+3 DO INIT
DO HDR
QUIT
+4 ;
PAD(DATA,LENGTH) ; -- SUBRTN to pad length of data
+1 QUIT $EXTRACT(DATA_$$REPEAT^XLFSTR(" ",LENGTH),1,LENGTH)
+2 ;
SP(NUM) ; -- SUBRTN to pad spaces
+1 QUIT $$PAD(" ",NUM)
+2 ;
PROV() ; -- ask for provider
+1 NEW Y,SCREEN
+2 SET SCREEN="I $D(^XUSEC(""PROVIDER"",+Y))"
+3 SET Y=$$READ^TIUU("PO^200:EMQZ","Select PROVIDER NAME","","",SCREEN)
+4 IF Y<1
WRITE !,"No provider selected"
DO RETURN^BTIUU
QUIT 0
+5 ;
+6 ; does provider have incomplete charts?
+7 IF '$ORDER(^BDGIC("APRV",+Y,0))
WRITE !!,"Provider does NOT have any incomplete charts.",!
DO RETURN^BTIUU
QUIT 0
+8 QUIT +Y
