| [613] | 1 | TIUPRPN6 ;SLC/MJC-Print PNs-Most Current Admission ; 6/26/01
|
|---|
| 2 | ;;1.0;TEXT INTEGRATION UTILITIES;**100,121**;Jun 20, 1997
|
|---|
| 3 | ;
|
|---|
| 4 | ADM ;prints PNs for LAST admission to either date of discharge or NOW
|
|---|
| 5 | ;this sort is chartable for either contiguous or separate
|
|---|
| 6 | ;also supports WORK copy
|
|---|
| 7 | ;TIU PRINT PN ADMISSION]
|
|---|
| 8 | ;
|
|---|
| 9 | N TIUDFN,TIUQT,DIC,Y
|
|---|
| 10 | D SETUP^TIUPRPN3("Print Progress Notes for selected patient's LAST admission")
|
|---|
| 11 | F W ! S DIC=2,DIC(0)="AEQMN" D ^DIC Q:Y<0 D K TIUQT
|
|---|
| 12 | .I '$O(^TIU(8925,"APTP",+Y,0)) W !!?5,$C(7),"There are no signed "
|
|---|
| 13 | .I W "progress notes on file for this patient.",! Q
|
|---|
| 14 | .N TIUFLAG,TIUSPG
|
|---|
| 15 | .S TIUDFN=Y
|
|---|
| 16 | .D NOTES(TIUDFN) Q:$D(TIUQT)
|
|---|
| 17 | .S TIUFLAG=$$FLAG^TIUPRPN3() Q:TIUFLAG']""
|
|---|
| 18 | .S TIUSPG=1
|
|---|
| 19 | .D DEVICE^TIUPRPN(TIUFLAG,TIUSPG)
|
|---|
| 20 | Q
|
|---|
| 21 | ;
|
|---|
| 22 | NOTES(TIUDFN) ;get the notes for the admission
|
|---|
| 23 | N VAIP,ADMDT,BEG,END,HOLD,CTR,DATE,IFN,DFN,DIR,Y
|
|---|
| 24 | S DFN=+TIUDFN,VAIP("D")="LAST" D IN5^VADPT
|
|---|
| 25 | I '$G(VAIP(1)) W !!?5,$C(7),"I don't have any record of an admission "
|
|---|
| 26 | I W "for this patient.",!?5,"Select another patient." S TIUQT=1 Q
|
|---|
| 27 | S ADMDT=VAIP(13,1)
|
|---|
| 28 | W !!,"Patient was admitted: ",$P(ADMDT,U,2)
|
|---|
| 29 | I $D(VAIP(17,1)) D
|
|---|
| 30 | .W !,"Patient was discharged: ",$P(VAIP(17,1),U,2),!
|
|---|
| 31 | .S DIR("A")="Print all progress notes written during this admission? "
|
|---|
| 32 | E D
|
|---|
| 33 | .W !!,"Patient has not been DISCHARGED.",!
|
|---|
| 34 | .S DIR("A")="Print all progress notes from admission date until NOW? "
|
|---|
| 35 | S DIR(0)="YA",DIR("B")="YES",DIR("A")=DIR("A")_"(Y/N) "
|
|---|
| 36 | S DIR("?")="^D HELP^TIUPRPN6" D ^DIR
|
|---|
| 37 | I $D(DIRUT) S TIUQT=1 Q
|
|---|
| 38 | I +$G(Y) S BEG=+ADMDT,END=$S($G(VAIP(17,1)):+VAIP(17,1),1:9999999)
|
|---|
| 39 | E D K %DT Q:$D(TIUQT)
|
|---|
| 40 | .W ! S %DT="AEPTX",%DT(0)="-NOW",%DT("A")="Print Notes Beginning: "
|
|---|
| 41 | .D ^%DT I $D(DTOUT)!(Y<0) S TIUQT=1 Q
|
|---|
| 42 | .S BEG=Y,%DT("A")=" Thru: "
|
|---|
| 43 | .S %DT="AEPTX" D ^%DT I $D(DTOUT)!(Y<0) S TIUQT=1 Q
|
|---|
| 44 | .S END=Y I END<BEG S HOLD=BEG,BEG=END,END=HOLD
|
|---|
| 45 | ;load up the notes
|
|---|
| 46 | W !!,"Searching for the notes "
|
|---|
| 47 | K ^TMP("TIUPR",$J),^TMP("TIUREPLACE",$J)
|
|---|
| 48 | S DATE=BEG
|
|---|
| 49 | F S DATE=$O(^TIU(8925,"APTP",DFN,DATE)) Q:'DATE!(DATE>END) D
|
|---|
| 50 | .S IFN=0 F S IFN=$O(^TIU(8925,"APTP",DFN,DATE,IFN)) Q:'IFN D
|
|---|
| 51 | ..W "." D REPLACE^TIUPRPN3(IFN,DATE,1501)
|
|---|
| 52 | S IFN=0 F S IFN=$O(^TMP("TIUREPLACE",$J,IFN)) Q:'IFN D
|
|---|
| 53 | .S DATE=^TMP("TIUREPLACE",$J,IFN,"DT")
|
|---|
| 54 | .S ^TMP("TIUPR",$J,$P(TIUDFN,U,2)_";"_DFN,DATE,IFN)="Vice SF 509"
|
|---|
| 55 | S CTR=+$G(^TMP("TIUREPLACE",$J))
|
|---|
| 56 | I '$D(^TMP("TIUPR",$J)) W !!,"No SIGNED notes found in this date "
|
|---|
| 57 | I W "range for this patient." S TIUQT=1 G NOTESX
|
|---|
| 58 | W !!,">> "_CTR_" note"_$S(CTR>1:"s",1:"")_" found.",!
|
|---|
| 59 | NOTESX ;
|
|---|
| 60 | K ^TMP("TIUREPLACE",$J)
|
|---|
| 61 | Q
|
|---|
| 62 | HELP ;help for yes/no print all notes for admission question
|
|---|
| 63 | W !!?5,"Answer YES and all the progress notes for this admission will "
|
|---|
| 64 | W !?5,"be printed in CONTIGUOUS format."
|
|---|
| 65 | W !!?5,"Answer NO and you will be asked to select a date range for "
|
|---|
| 66 | W !?5,"this patient."
|
|---|
| 67 | Q
|
|---|
