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

TIUPRPN3.m

Go to the documentation of this file. 
  1. TIUPRPN3 ;SLC/MJC - Sort PNs for Printing; May 09, 2024@10:32
  1.  ;;1.0;TEXT INTEGRATION UTILITIES;**100,121,367**;Jun 20, 1997;Build 9
  1.  ;
  1. SETUP(TITLE) ;displays centered option hdr
  1.  N TIULINE
  1.  S $P(TIULINE,"-",80)=""
  1.  W @IOF,!!?(IOM-$L(TITLE)\2),TITLE,!,TIULINE,!
  1.  Q
  1. PT ;sorts PNs to prt by pt for selected date range
  1.  ;these notes are chartable either contiguous or separate pgs
  1.  ;[TIU PRINT PN PT]
  1.  ;
  1.  N TIUDFN,TIUQT,DIC,Y,TIUXREF,CTR1
  1.  D SETUP("Print Progress Notes for a Selected PATIENT")
  1.  F  W ! S DIC=2,DIC(0)="AEQMN" D ^DIC Q:Y<0  D  K TIUQT
  1.  .N TIUFLAG,TIUSPG
  1.  .S CTR1=0,TIUDFN=Y,TIUXREF="APTP" ;pt/pt x-ref
  1.  .D FETCH(TIUXREF,TIUDFN,.CTR1) Q:$D(TIUQT)
  1.  .S TIUFLAG=$$FLAG() Q:TIUFLAG']""
  1.  .I +$G(TIUFLAG),CTR1>1 S TIUSPG=$$PAGE Q:TIUSPG']""
  1.  .S TIUSPG=$S(+$G(TIUSPG):0,1:1)
  1.  .K DIC
  1.  .D DEVICE^TIUPRPN(TIUFLAG,TIUSPG)
  1.  Q
  1.  ;
  1. AUTHOR ;sorts PNs to prt by author for selected date range
  1.  ;these guys are only chartable if prted on separate pages
  1.  ;[TIU PRINT PN AUTHOR]
  1.  ;
  1.  N TIUDUZ,TIUQT,DIC,Y,TIUXREF
  1.  D SETUP("Print Progress Notes for a Selected AUTHOR")
  1.  S DIC=200,DIC(0)="AEQMN",DIC("A")="AUTHOR: "
  1.  F  W ! D ^DIC Q:Y<0  D  K TIUQT
  1.  .N TIUFLAG,TIUSPG
  1.  .S TIUDUZ=Y,TIUXREF="AAUP" ;author/author x-ref
  1.  .D FETCH(TIUXREF,TIUDUZ) Q:$D(TIUQT)
  1.  .S TIUFLAG=$$FLAG() Q:TIUFLAG']""
  1.  .S TIUSPG=$S(+$G(TIUFLAG):0,1:1)
  1.  .K DIC
  1.  .D DEVICE^TIUPRPN(TIUFLAG,TIUSPG)
  1.  .S DIC=200,DIC(0)="AEQMN",DIC("A")="AUTHOR: "
  1.  Q
  1.  ;
  1. LOC ;sorts PNs to prt by location for selected date range
  1.  ;they are only chartable if prted on separate pages
  1.  ;[TIU PRINT PN LOC]
  1.  ;
  1.  N TIULOC,TIUQT,DIC,Y,TIUXREF
  1.  D SETUP("Print Progress Notes for a Selected LOCATION")
  1.  S DIC=44,DIC(0)="AEQMN"
  1.  F  W ! D ^DIC Q:Y<0  D  K TIUQT
  1.  .N TIUFLAG,TIUSPG
  1.  .S TIULOC=Y,TIUXREF="ALOCP" ;location/location x-ref
  1.  .D FETCH(TIUXREF,TIULOC) Q:$D(TIUQT)
  1.  .S TIUFLAG=$$FLAG() Q:TIUFLAG']""
  1.  .S TIUSPG=$S(+$G(TIUFLAG):0,1:1)
  1.  .K DIC
  1.  .D DEVICE^TIUPRPN(TIUFLAG,TIUSPG)
  1.  .S DIC=44,DIC(0)="AEQMN"
  1.  Q
  1.  ;
  1. FETCH(TIUXREF,ENTITY,CTR1) ;get available notes, select date range
  1.  ; Passes back optional CTR1 = # of notes
  1.  N OLD,NEW,BEG,END,HOLD,SORT,DFN,IFN,Y,DATE
  1.  S OLD=0 S OLD=$O(^TIU(8925,TIUXREF,+ENTITY,OLD))
  1.  I 'OLD D  S TIUQT=1 Q
  1.  .W !!,$C(7),"No signed notes available for "_$P(ENTITY,U,2),!
  1.  S OLD=$O(^TIU(8925,TIUXREF,+ENTITY,0))
  1.  S NEW=$O(^TIU(8925,TIUXREF,+ENTITY,9999999),-1)
  1.  W !!,"Available note",$S(OLD'=NEW:"s",1:""),": "
  1.  W $$FMTE^XLFDT(OLD,"D")
  1.  I OLD'=NEW W " thru ",$$FMTE^XLFDT(NEW,"D")
  1. FISH I OLD=NEW S (BEG,END)=$E(OLD,1,7)
  1.  E  D  W ! K %DT G:$D(TIUQT) FETCHX
  1.  .S %DT="AEPTX",%DT(0)="-NOW",%DT("A")="Print Notes Beginning: "
  1.  .D ^%DT I $D(DTOUT)!(Y<0) S TIUQT=1 Q
  1.  .S BEG=Y,%DT("A")="                 Thru: "
  1.  .S %DT="AEPTX" D ^%DT I $D(DTOUT)!(Y<0) S TIUQT=1 Q
  1.  .S END=Y I END<BEG S HOLD=BEG,BEG=END,END=HOLD
  1.  ; load up the notes
  1.  W !!,"Searching for the notes"
  1.  K ^TMP("TIUPR",$J),^TMP("TIUREPLACE",$J)
  1.  S DATE=BEG,END=END+.9999999
  1.  F  S DATE=$O(^TIU(8925,TIUXREF,+ENTITY,DATE)) Q:'DATE!(DATE>END)  D
  1.  .S IFN=0 F  S IFN=$O(^TIU(8925,TIUXREF,+ENTITY,DATE,IFN)) Q:'IFN  D
  1.  ..W "." D REPLACE(IFN,DATE,1501)
  1.  S IFN=0 F  S IFN=$O(^TMP("TIUREPLACE",$J,IFN)) Q:'IFN  Q:'^TMP("TIUREPLACE",$J,IFN)  D
  1.  .S DFN=$P(^TIU(8925,IFN,0),U,2),SORT=$P(^DPT(DFN,0),U)_";"_DFN
  1.  .S DATE=^TMP("TIUREPLACE",$J,IFN,"DT")
  1.  .S ^TMP("TIUPR",$J,SORT,DATE,IFN)="Vice SF 509"
  1.  I '$D(^TMP("TIUPR",$J)) W !!,"No notes found- try again!",! G FISH
  1.  S CTR1=+$G(^TMP("TIUREPLACE",$J))
  1.  W !,">> "_CTR1_" note"_$S(CTR1>1:"s",1:"")_" found for "_$P(ENTITY,U,2)
  1. FETCHX ;
  1.  K ^TMP("TIUREPLACE",$J)
  1.  Q
  1.  ;
  1. REPLACE(TIUDA,DATTIM,DTFIELD,CKCANVW) ; Populate TMP array
  1.  ;w record received, replacing ID kids or addenda with their parents.
  1.  ; Requires TIUDA. 
  1.  ; Sets ^TMP("TIUREPLACE",$J,IFN)=1 or 1^TIUDA, or 0,
  1.  ;where IFN is TIUDA or its ID parent.
  1.  ; If TIUDA is replaced by its parent, then
  1.  ;^TMP("TIUREPLACE",$J,IFN)=1^TIUDA,
  1.  ;to know what child the parent was included in the list for.
  1.  ; If CKCANVW = 1 is received, code checks CAN VIEW before
  1.  ;setting TMP array.
  1.  ; Sets ^TMP("TIUREPLACE",$J) = # of [viewable] elements in array
  1.  ; Optional DATTIM = 
  1.  ;      Signature date/time of record, NOT inverse, if DTFIELD = 1501
  1.  ;      Reference date/time of record, inverse, if DTFIELD = 1301
  1.  ;If DATTIM received=non null, sets
  1.  ; ^TMP("TIUREPLACE",$J,IFN,"DT")=DATTIM
  1.  ;  Optional DTFIELD = 1501 or 1301; default = 1501
  1.  ; 1/11/01 cf REPLACE^TIUSRVLL.
  1.  N IDPRNT,PDATTIM,DTNODE,PCANDO,CANDO
  1.  S ^TMP("TIUREPLACE",$J)=+$G(^TMP("TIUREPLACE",$J))
  1.  S IDPRNT=+$G(^TIU(8925,TIUDA,21)) ; ID parent
  1.  ; -- If user can't view record, quit and
  1.  ;    if it is parent, track it as already processed
  1.  ;    (but not a 'good' record):
  1.  I $G(CKCANVW) D  Q:'$G(CANDO)
  1.  . S CANDO=+$$CANDO^TIULP(TIUDA,"VIEW")
  1.  . I '$G(CANDO),$O(^TIU(8925,"GDAD",TIUDA,0)) S ^TMP("TIUREPLACE",$J,TIUDA)=0
  1.  S DTNODE=$S($G(DTFIELD)=1301:13,1:15)
  1.  ; -- If record is child with nonexistent parent,
  1.  ;    treat record as stand-alone:
  1.  I '$D(^TIU(8925,IDPRNT,0)) S IDPRNT=0
  1.  ; -- If record is child, & parent already in array
  1.  ;    from previous cycle (viewable or not), just quit:
  1.  I IDPRNT,$D(^TMP("TIUREPLACE",$J,IDPRNT)) G REPX
  1.  ; -- If record is child, & parent not viewable,
  1.  ;    track parent as processed but not 'good' & quit:
  1.  I IDPRNT,$G(CKCANVW) D  I '$G(PCANDO) G REPX
  1.  . S PCANDO=+$$CANDO^TIULP(IDPRNT,"VIEW")
  1.  . I '$G(PCANDO) S ^TMP("TIUREPLACE",$J,IDPRNT)=0
  1.  ; -- If record is not child, just put it
  1.  ;    in array and quit: --
  1.  I 'IDPRNT D  G REPX
  1.  . ; -- If record is already in array as parent from previous cycle
  1.  . ;    (viewable or not), and is now received on its own merit,
  1.  . ;    quit & don't consider it there because of a child:
  1.  . I $D(^TMP("TIUREPLACE",$J,TIUDA)) S ^TMP("TIUREPLACE",$J,TIUDA)=+^TMP("TIUREPLACE",$J,TIUDA) Q
  1.  . S ^TMP("TIUREPLACE",$J,TIUDA)=1
  1.  . I $G(DATTIM)'="" S ^TMP("TIUREPLACE",$J,TIUDA,"DT")=DATTIM
  1.  . S ^TMP("TIUREPLACE",$J)=$G(^TMP("TIUREPLACE",$J))+1
  1.  ; -- If record is child, put its parent in array:
  1.  I IDPRNT,$G(DATTIM)'="" D
  1.  . S PDATTIM=+$G(^TIU(8925,IDPRNT,DTNODE))
  1.  . I PDATTIM,DTNODE=13 S PDATTIM=9999999-PDATTIM
  1.  I IDPRNT D  G REPX
  1.  . S ^TMP("TIUREPLACE",$J,IDPRNT)=1_U_TIUDA ;parent in array because of child TIUDA
  1.  . I $G(DATTIM)'="" S ^TMP("TIUREPLACE",$J,IDPRNT,"DT")=PDATTIM
  1.  . S ^TMP("TIUREPLACE",$J)=$G(^TMP("TIUREPLACE",$J))+1
  1. REPX Q
  1.  ;
  1. FLAG() ;asks question for CHART vs. WORK copies
  1.  ;returns TIUFLAG=1 if CHART copy - TIUFLAG=0 if WORK copy - NULL if '^'
  1.  S TIUFLAG=$$READ^TIUU("SA^C:CHART;W:WORK","Do you want WORK copies or CHART copies? ","CHART","^D HELP^TIUPRPN3")
  1.  I $E(TIUFLAG)="^" S TIUFLAG=""
  1.  E  S TIUFLAG=$S($P(TIUFLAG,U)="C":1,1:0)
  1.  Q TIUFLAG
  1.  ;
  1. PAGE() ;asks question for CONTIGUOUS vs. SEPARATE PAGE print
  1.  ;returns TIUSPG=0 for CONTIGUOUS - TIUSPG=1 SEPARATE PAGE - NULL if '^'
  1.  S TIUSPG=$$READ^TIUU("YA","Do you want to start each note on a new page? ","NO","^D HELP1^TIUPRPN3")
  1.  I $E(TIUSPG)="^" S TIUSPG=""
  1.  E  S TIUSPG=$S(+$G(TIUSPG):1,1:0)
  1.  Q TIUSPG
  1. HELP ; answers questions regarding WORK vs. CHART copies
  1.  W !!?5,"The FOOTERS of WORK/CHART copies vary significantly.  The WORK"
  1.  W !?5,"FOOTER has the patient's phone number and is clearly marked:"
  1.  W !?5,"'NOT FOR MEDICAL RECORD'.  Unless you really intend to file the"
  1.  W !?5,"note(s) in the chart- print a WORK copy."
  1.  Q
  1. HELP1 ; answers the 'ea note on a new page' question
  1.  W !!?5,"The option selected will produce CHARTABLE contiguous notes."
  1.  W !?5,"If you are filling in a chart that has handwritten notes, or,"
  1.  W !?5,"you'd prefer to begin each note on a new page; answer 'YES'."
  1.  Q