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