- 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
- 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
