[613] | 1 | TIUPRPN5 ;SLC/MJC-Sort PNs for Prting by Location;6/26/01
|
---|
| 2 | ;;1.0;TEXT INTEGRATION UTILITIES;**100,121**;Jun 20, 1997
|
---|
| 3 | ;
|
---|
| 4 | LOC ;sorts PNs for prting by CLINIC location
|
---|
| 5 | ;these notes are chartable contiguous or separate
|
---|
| 6 | ;this option is screened to exclude WARDs
|
---|
| 7 | ;sites should use the [TIU PRINT PN WARD] option which sorts
|
---|
| 8 | ;by BED NUMBER for current inpts on that ward for INPT notes
|
---|
| 9 | ;[TIU PRINT PN OUTPT LOC]
|
---|
| 10 | ;
|
---|
| 11 | N DIC,Y,TIUQT,TIULOC
|
---|
| 12 | D SETUP^TIUPRPN3("Print Progress Notes for OUTPATIENT LOCATION")
|
---|
| 13 | DIC F D Q:$D(TIUQT)
|
---|
| 14 | .S DIC=8925.93,DIC(0)="AEQMNZ",DIC("A")="Select OUTPATIENT location: "
|
---|
| 15 | .S DIC("S")="I $P($G(^SC(+$P($G(^TIU(8925.93,+Y,0)),U),0)),U,3)'=""W"""
|
---|
| 16 | .W ! D ^DIC K DIC("S") I Y<0 S TIUQT=1 Q
|
---|
| 17 | .S TIULOC=+Y(0)_U_+Y_U_Y(0,0)
|
---|
| 18 | .I '$D(^TIU(8925,"ALOCP",+TIULOC)) D Q
|
---|
| 19 | ..W !,$C(7),"There are no signed Progress Notes for this location!!"
|
---|
| 20 | .D NOTES(TIULOC)
|
---|
| 21 | Q
|
---|
| 22 | ;
|
---|
| 23 | NOTES(TIULOC) ;returns date/time;ien of last note prted
|
---|
| 24 | N OLD,NEW,Y,BEG,IFN,TIUSPG,CTR,TIULAST,ANS,MSG,TIUQT,DFN,SORT
|
---|
| 25 | K ^TMP("TIUREPLACE",$J)
|
---|
| 26 | S MSG=1,TIULAST=$P($G(^TIU(8925.93,+$P(TIULOC,U,2),1)),U,2)
|
---|
| 27 | I TIULAST]"" D Q:$D(TIUQT)
|
---|
| 28 | .I '+$G(TIULAST)!'$P(TIULAST,";",2)!('$D(^TIU(8925,"ALOCP",+TIULOC,+TIULAST,+$P(TIULAST,";",2)))) S $P(^TIU(8925.93,+$P(TIULOC,U,2),1),U,2)="",MSG=2 Q
|
---|
| 29 | .S BEG=+TIULAST
|
---|
| 30 | .W !!,"The last note printed for this location using this option was "
|
---|
| 31 | .W !,"signed ",$$FMTE^XLFDT(BEG,"1P"),!!
|
---|
| 32 | .S ANS=$$READ^TIUU("YA","Print from this point on? ","YES","^D HELP^TIUPRPN5")
|
---|
| 33 | .I $D(DIRUT) S TIUQT=1 Q
|
---|
| 34 | .I +$G(ANS) S IFN=$P(TIULAST,U,2) Q
|
---|
| 35 | .S $P(^TIU(8925.93,+$P(TIULOC,U,2),1),U,2)="",MSG=3
|
---|
| 36 | I $P($G(^TIU(8925.93,+$P(TIULOC,U,2),1)),U,2)']"" D Q:$D(TIUQT)
|
---|
| 37 | .D @MSG ;writes message to explain date selection
|
---|
| 38 | RANGE .S OLD=$O(^TIU(8925,"ALOCP",+TIULOC,0))
|
---|
| 39 | .S NEW=$O(^TIU(8925,"ALOCP",+TIULOC,9999999),-1)
|
---|
| 40 | .W !," The OLDEST note was signed: ",$$FMTE^XLFDT(OLD,"1P")
|
---|
| 41 | .W !,"The MOST RECENT note was signed: ",$$FMTE^XLFDT(NEW,"1P"),!
|
---|
| 42 | .W !,"Select a date and I will print all signed notes for "
|
---|
| 43 | .W !,$P(TIULOC,U,3)," from this date until NOW.",!
|
---|
| 44 | DATE .S %DT="AEPX",%DT(0)="-NOW",%DT("A")="Print Notes Beginning: "
|
---|
| 45 | .D ^%DT K %DT I $D(DTOUT)!(Y<0) S TIUQT=1 Q
|
---|
| 46 | .I Y>NEW W $C(7),!?5,"Pick a date between the OLDEST and the MOST "
|
---|
| 47 | .I W "RECENT." G DATE
|
---|
| 48 | .S BEG=Y
|
---|
| 49 | S CTR=0 F S BEG=$O(^TIU(8925,"ALOCP",+TIULOC,BEG)) Q:'BEG D
|
---|
| 50 | .I '$D(IFN) S IFN=0
|
---|
| 51 | .F S IFN=$O(^TIU(8925,"ALOCP",+TIULOC,BEG,IFN)) Q:'IFN D
|
---|
| 52 | ..W "." D REPLACE^TIUPRPN3(IFN,BEG,1501)
|
---|
| 53 | S IFN=0 F S IFN=$O(^TMP("TIUREPLACE",$J,IFN)) Q:'IFN D
|
---|
| 54 | .S DFN=$P(^TIU(8925,IFN,0),U,2),SORT=$P(^DPT(DFN,0),U)_";"_DFN
|
---|
| 55 | .S BEG=^TMP("TIUREPLACE",$J,IFN,"DT")
|
---|
| 56 | .S ^TMP("TIUPR",$J,SORT,BEG,IFN)="Vice SF 509"
|
---|
| 57 | .S TIULAST=BEG_";"_IFN
|
---|
| 58 | S CTR=+$G(^TMP("TIUREPLACE",$J))
|
---|
| 59 | I CTR=0 W $C(7),!!,"No notes have been signed for this location since "
|
---|
| 60 | I W $$FMTE^XLFDT(+TIULAST,"1P") G NOTESX
|
---|
| 61 | W !,">> "_CTR_" note"_$S(CTR>1:"s",1:"")_" found for "_$P(TIULOC,U,3)
|
---|
| 62 | I CTR'>1 S TIUSPG=1
|
---|
| 63 | E S TIUSPG=$$PAGE^TIUPRPN3 G:TIUSPG']"" NOTESX S TIUSPG=$S(+$G(TIUSPG):0,1:1)
|
---|
| 64 | DEV S %ZIS("B")=$P($G(^%ZIS(1,+$P($G(^TIU(8925.93,$P(TIULOC,U,2),1)),U,3),0),""),U) ;brings up default prter from param file
|
---|
| 65 | W ! S %ZIS="Q" D ^%ZIS I POP K POP G EXIT
|
---|
| 66 | I $E(IOST)="C" W $C(7),$C(7),!?5,"You must select a "
|
---|
| 67 | I W "printer for this option!!" G DEV
|
---|
| 68 | S $P(^TIU(8925.93,$P(TIULOC,U,2),0),U,4)=""
|
---|
| 69 | I $D(IO("Q")) K IO("Q") D G EXIT
|
---|
| 70 | .S ZTRTN="PRINT^TIUPRPN5",ZTSAVE("^TMP(""TIUPR"",$J,")=""
|
---|
| 71 | .S ZTSAVE("TIUSPG")="",ZTSAVE("TIULAST")="",ZTSAVE("TIULOC")=""
|
---|
| 72 | .S ZTDESC="TIU PRT PNS BY LOCATION"
|
---|
| 73 | .D ^%ZTLOAD W !,$S($D(ZTSK):"Request Queued!",1:"Request Canceled!")
|
---|
| 74 | .K ZTSK,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,%ZIS,TIULAST,TIUSPG,TIULOC
|
---|
| 75 | .D HOME^%ZIS
|
---|
| 76 | U IO D PRINT,^%ZISC
|
---|
| 77 | NOTESX ;
|
---|
| 78 | K ^TMP("TIUREPLACE",$J)
|
---|
| 79 | Q
|
---|
| 80 | PRINT ;
|
---|
| 81 | K ^TMP("TIULQ",$J)
|
---|
| 82 | I $D(ZTQUEUED) S ZTREQ="@"
|
---|
| 83 | D PRINT^TIUPRPN1(1,$G(TIUSPG))
|
---|
| 84 | S $P(^TIU(8925.93,$P(TIULOC,U,2),1),U,2)=TIULAST
|
---|
| 85 | EXIT K ^TMP("TIULQ",$J),^TMP("TIUPR",$J),^TMP("TIUREPLACE",$J)
|
---|
| 86 | Q
|
---|
| 87 | ;
|
---|
| 88 | 1 W !!,"I don't seem to have any record of you having used this option "
|
---|
| 89 | W !,"to print progress notes for this location.",!
|
---|
| 90 | Q
|
---|
| 91 | 2 W !!,"I could not determine what the last note printed for this "
|
---|
| 92 | W !,"location was."
|
---|
| 93 | W !!,"Please select a date and all notes from that date to NOW will be"
|
---|
| 94 | W !,"printed. The last note printed will become the new base date.",!
|
---|
| 95 | Q
|
---|
| 96 | 3 W !!,"OK- then select a different date.",!
|
---|
| 97 | Q
|
---|
| 98 | HELP ; help for continue from this point prompt
|
---|
| 99 | W !!,"Every note that has been signed since this date (last time this"
|
---|
| 100 | W !,"notes were printed using this option) until NOW will be printed."
|
---|
| 101 | Q
|
---|