TIUPRPN6 ;SLC/MJC-Print PNs-Most Current Admission ; 6/26/01
;;1.0;TEXT INTEGRATION UTILITIES;**100,121**;Jun 20, 1997
;
ADM ;prints PNs for LAST admission to either date of discharge or NOW
;this sort is chartable for either contiguous or separate
;also supports WORK copy
;TIU PRINT PN ADMISSION]
;
N TIUDFN,TIUQT,DIC,Y
D SETUP^TIUPRPN3("Print Progress Notes for selected patient's LAST admission")
F W ! S DIC=2,DIC(0)="AEQMN" D ^DIC Q:Y<0 D K TIUQT
.I '$O(^TIU(8925,"APTP",+Y,0)) W !!?5,$C(7),"There are no signed "
.I W "progress notes on file for this patient.",! Q
.N TIUFLAG,TIUSPG
.S TIUDFN=Y
.D NOTES(TIUDFN) Q:$D(TIUQT)
.S TIUFLAG=$$FLAG^TIUPRPN3() Q:TIUFLAG']""
.S TIUSPG=1
.D DEVICE^TIUPRPN(TIUFLAG,TIUSPG)
Q
;
NOTES(TIUDFN) ;get the notes for the admission
N VAIP,ADMDT,BEG,END,HOLD,CTR,DATE,IFN,DFN,DIR,Y
S DFN=+TIUDFN,VAIP("D")="LAST" D IN5^VADPT
I '$G(VAIP(1)) W !!?5,$C(7),"I don't have any record of an admission "
I W "for this patient.",!?5,"Select another patient." S TIUQT=1 Q
S ADMDT=VAIP(13,1)
W !!,"Patient was admitted: ",$P(ADMDT,U,2)
I $D(VAIP(17,1)) D
.W !,"Patient was discharged: ",$P(VAIP(17,1),U,2),!
.S DIR("A")="Print all progress notes written during this admission? "
E D
.W !!,"Patient has not been DISCHARGED.",!
.S DIR("A")="Print all progress notes from admission date until NOW? "
S DIR(0)="YA",DIR("B")="YES",DIR("A")=DIR("A")_"(Y/N) "
S DIR("?")="^D HELP^TIUPRPN6" D ^DIR
I $D(DIRUT) S TIUQT=1 Q
I +$G(Y) S BEG=+ADMDT,END=$S($G(VAIP(17,1)):+VAIP(17,1),1:9999999)
E D K %DT Q:$D(TIUQT)
.W ! 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
F S DATE=$O(^TIU(8925,"APTP",DFN,DATE)) Q:'DATE!(DATE>END) D
.S IFN=0 F S IFN=$O(^TIU(8925,"APTP",DFN,DATE,IFN)) Q:'IFN D
..W "." D REPLACE^TIUPRPN3(IFN,DATE,1501)
S IFN=0 F S IFN=$O(^TMP("TIUREPLACE",$J,IFN)) Q:'IFN D
.S DATE=^TMP("TIUREPLACE",$J,IFN,"DT")
.S ^TMP("TIUPR",$J,$P(TIUDFN,U,2)_";"_DFN,DATE,IFN)="Vice SF 509"
S CTR=+$G(^TMP("TIUREPLACE",$J))
I '$D(^TMP("TIUPR",$J)) W !!,"No SIGNED notes found in this date "
I W "range for this patient." S TIUQT=1 G NOTESX
W !!,">> "_CTR_" note"_$S(CTR>1:"s",1:"")_" found.",!
NOTESX ;
K ^TMP("TIUREPLACE",$J)
Q
HELP ;help for yes/no print all notes for admission question
W !!?5,"Answer YES and all the progress notes for this admission will "
W !?5,"be printed in CONTIGUOUS format."
W !!?5,"Answer NO and you will be asked to select a date range for "
W !?5,"this patient."
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIUPRPN6 2856 printed Dec 13, 2024@02:43:51 Page 2
TIUPRPN6 ;SLC/MJC-Print PNs-Most Current Admission ; 6/26/01
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**100,121**;Jun 20, 1997
+2 ;
ADM ;prints PNs for LAST admission to either date of discharge or NOW
+1 ;this sort is chartable for either contiguous or separate
+2 ;also supports WORK copy
+3 ;TIU PRINT PN ADMISSION]
+4 ;
+5 NEW TIUDFN,TIUQT,DIC,Y
+6 DO SETUP^TIUPRPN3("Print Progress Notes for selected patient's LAST admission")
+7 FOR
WRITE !
SET DIC=2
SET DIC(0)="AEQMN"
DO ^DIC
if Y<0
QUIT
Begin DoDot:1
+8 IF '$ORDER(^TIU(8925,"APTP",+Y,0))
WRITE !!?5,$CHAR(7),"There are no signed "
+9 IF $TEST
WRITE "progress notes on file for this patient.",!
QUIT
+10 NEW TIUFLAG,TIUSPG
+11 SET TIUDFN=Y
+12 DO NOTES(TIUDFN)
if $DATA(TIUQT)
QUIT
+13 SET TIUFLAG=$$FLAG^TIUPRPN3()
if TIUFLAG']""
QUIT
+14 SET TIUSPG=1
+15 DO DEVICE^TIUPRPN(TIUFLAG,TIUSPG)
End DoDot:1
KILL TIUQT
+16 QUIT
+17 ;
NOTES(TIUDFN) ;get the notes for the admission
+1 NEW VAIP,ADMDT,BEG,END,HOLD,CTR,DATE,IFN,DFN,DIR,Y
+2 SET DFN=+TIUDFN
SET VAIP("D")="LAST"
DO IN5^VADPT
+3 IF '$GET(VAIP(1))
WRITE !!?5,$CHAR(7),"I don't have any record of an admission "
+4 IF $TEST
WRITE "for this patient.",!?5,"Select another patient."
SET TIUQT=1
QUIT
+5 SET ADMDT=VAIP(13,1)
+6 WRITE !!,"Patient was admitted: ",$PIECE(ADMDT,U,2)
+7 IF $DATA(VAIP(17,1))
Begin DoDot:1
+8 WRITE !,"Patient was discharged: ",$PIECE(VAIP(17,1),U,2),!
+9 SET DIR("A")="Print all progress notes written during this admission? "
End DoDot:1
+10 IF '$TEST
Begin DoDot:1
+11 WRITE !!,"Patient has not been DISCHARGED.",!
+12 SET DIR("A")="Print all progress notes from admission date until NOW? "
End DoDot:1
+13 SET DIR(0)="YA"
SET DIR("B")="YES"
SET DIR("A")=DIR("A")_"(Y/N) "
+14 SET DIR("?")="^D HELP^TIUPRPN6"
DO ^DIR
+15 IF $DATA(DIRUT)
SET TIUQT=1
QUIT
+16 IF +$GET(Y)
SET BEG=+ADMDT
SET END=$SELECT($GET(VAIP(17,1)):+VAIP(17,1),1:9999999)
+17 IF '$TEST
Begin DoDot:1
+18 WRITE !
SET %DT="AEPTX"
SET %DT(0)="-NOW"
SET %DT("A")="Print Notes Beginning: "
+19 DO ^%DT
IF $DATA(DTOUT)!(Y<0)
SET TIUQT=1
QUIT
+20 SET BEG=Y
SET %DT("A")=" Thru: "
+21 SET %DT="AEPTX"
DO ^%DT
IF $DATA(DTOUT)!(Y<0)
SET TIUQT=1
QUIT
+22 SET END=Y
IF END<BEG
SET HOLD=BEG
SET BEG=END
SET END=HOLD
End DoDot:1
KILL %DT
if $DATA(TIUQT)
QUIT
+23 ;load up the notes
+24 WRITE !!,"Searching for the notes "
+25 KILL ^TMP("TIUPR",$JOB),^TMP("TIUREPLACE",$JOB)
+26 SET DATE=BEG
+27 FOR
SET DATE=$ORDER(^TIU(8925,"APTP",DFN,DATE))
if 'DATE!(DATE>END)
QUIT
Begin DoDot:1
+28 SET IFN=0
FOR
SET IFN=$ORDER(^TIU(8925,"APTP",DFN,DATE,IFN))
if 'IFN
QUIT
Begin DoDot:2
+29 WRITE "."
DO REPLACE^TIUPRPN3(IFN,DATE,1501)
End DoDot:2
End DoDot:1
+30 SET IFN=0
FOR
SET IFN=$ORDER(^TMP("TIUREPLACE",$JOB,IFN))
if 'IFN
QUIT
Begin DoDot:1
+31 SET DATE=^TMP("TIUREPLACE",$JOB,IFN,"DT")
+32 SET ^TMP("TIUPR",$JOB,$PIECE(TIUDFN,U,2)_";"_DFN,DATE,IFN)="Vice SF 509"
End DoDot:1
+33 SET CTR=+$GET(^TMP("TIUREPLACE",$JOB))
+34 IF '$DATA(^TMP("TIUPR",$JOB))
WRITE !!,"No SIGNED notes found in this date "
+35 IF $TEST
WRITE "range for this patient."
SET TIUQT=1
GOTO NOTESX
+36 WRITE !!,">> "_CTR_" note"_$SELECT(CTR>1:"s",1:"")_" found.",!
NOTESX ;
+1 KILL ^TMP("TIUREPLACE",$JOB)
+2 QUIT
HELP ;help for yes/no print all notes for admission question
+1 WRITE !!?5,"Answer YES and all the progress notes for this admission will "
+2 WRITE !?5,"be printed in CONTIGUOUS format."
+3 WRITE !!?5,"Answer NO and you will be asked to select a date range for "
+4 WRITE !?5,"this patient."
+5 QUIT
