source: WorldVistAEHR/trunk/r/TEXT_INTEGRATION_UTILITIES-GMRP-TIU/TIUPRPN6.m@ 975

Last change on this file since 975 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.7 KB
Line 
1TIUPRPN6 ;SLC/MJC-Print PNs-Most Current Admission ; 6/26/01
2 ;;1.0;TEXT INTEGRATION UTILITIES;**100,121**;Jun 20, 1997
3 ;
4ADM ;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 ;
22NOTES(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.",!
59NOTESX ;
60 K ^TMP("TIUREPLACE",$J)
61 Q
62HELP ;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
Note: See TracBrowser for help on using the repository browser.