Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BTIUICL

BTIUICL.m

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