- TIUPRPN5 ;SLC/MJC-Sort PNs for Prting by Location;6/26/01
- ;;1.0;TEXT INTEGRATION UTILITIES;**100,121**;Jun 20, 1997
- ;
- LOC ;sorts PNs for prting by CLINIC location
- ;these notes are chartable contiguous or separate
- ;this option is screened to exclude WARDs
- ;sites should use the [TIU PRINT PN WARD] option which sorts
- ;by BED NUMBER for current inpts on that ward for INPT notes
- ;[TIU PRINT PN OUTPT LOC]
- ;
- N DIC,Y,TIUQT,TIULOC
- D SETUP^TIUPRPN3("Print Progress Notes for OUTPATIENT LOCATION")
- DIC F D Q:$D(TIUQT)
- .S DIC=8925.93,DIC(0)="AEQMNZ",DIC("A")="Select OUTPATIENT location: "
- .S DIC("S")="I $P($G(^SC(+$P($G(^TIU(8925.93,+Y,0)),U),0)),U,3)'=""W"""
- .W ! D ^DIC K DIC("S") I Y<0 S TIUQT=1 Q
- .S TIULOC=+Y(0)_U_+Y_U_Y(0,0)
- .I '$D(^TIU(8925,"ALOCP",+TIULOC)) D Q
- ..W !,$C(7),"There are no signed Progress Notes for this location!!"
- .D NOTES(TIULOC)
- Q
- ;
- NOTES(TIULOC) ;returns date/time;ien of last note prted
- N OLD,NEW,Y,BEG,IFN,TIUSPG,CTR,TIULAST,ANS,MSG,TIUQT,DFN,SORT
- K ^TMP("TIUREPLACE",$J)
- S MSG=1,TIULAST=$P($G(^TIU(8925.93,+$P(TIULOC,U,2),1)),U,2)
- I TIULAST]"" D Q:$D(TIUQT)
- .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
- .S BEG=+TIULAST
- .W !!,"The last note printed for this location using this option was "
- .W !,"signed ",$$FMTE^XLFDT(BEG,"1P"),!!
- .S ANS=$$READ^TIUU("YA","Print from this point on? ","YES","^D HELP^TIUPRPN5")
- .I $D(DIRUT) S TIUQT=1 Q
- .I +$G(ANS) S IFN=$P(TIULAST,U,2) Q
- .S $P(^TIU(8925.93,+$P(TIULOC,U,2),1),U,2)="",MSG=3
- I $P($G(^TIU(8925.93,+$P(TIULOC,U,2),1)),U,2)']"" D Q:$D(TIUQT)
- .D @MSG ;writes message to explain date selection
- RANGE .S OLD=$O(^TIU(8925,"ALOCP",+TIULOC,0))
- .S NEW=$O(^TIU(8925,"ALOCP",+TIULOC,9999999),-1)
- .W !," The OLDEST note was signed: ",$$FMTE^XLFDT(OLD,"1P")
- .W !,"The MOST RECENT note was signed: ",$$FMTE^XLFDT(NEW,"1P"),!
- .W !,"Select a date and I will print all signed notes for "
- .W !,$P(TIULOC,U,3)," from this date until NOW.",!
- DATE .S %DT="AEPX",%DT(0)="-NOW",%DT("A")="Print Notes Beginning: "
- .D ^%DT K %DT I $D(DTOUT)!(Y<0) S TIUQT=1 Q
- .I Y>NEW W $C(7),!?5,"Pick a date between the OLDEST and the MOST "
- .I W "RECENT." G DATE
- .S BEG=Y
- S CTR=0 F S BEG=$O(^TIU(8925,"ALOCP",+TIULOC,BEG)) Q:'BEG D
- .I '$D(IFN) S IFN=0
- .F S IFN=$O(^TIU(8925,"ALOCP",+TIULOC,BEG,IFN)) Q:'IFN D
- ..W "." D REPLACE^TIUPRPN3(IFN,BEG,1501)
- S IFN=0 F S IFN=$O(^TMP("TIUREPLACE",$J,IFN)) Q:'IFN D
- .S DFN=$P(^TIU(8925,IFN,0),U,2),SORT=$P(^DPT(DFN,0),U)_";"_DFN
- .S BEG=^TMP("TIUREPLACE",$J,IFN,"DT")
- .S ^TMP("TIUPR",$J,SORT,BEG,IFN)="Vice SF 509"
- .S TIULAST=BEG_";"_IFN
- S CTR=+$G(^TMP("TIUREPLACE",$J))
- I CTR=0 W $C(7),!!,"No notes have been signed for this location since "
- I W $$FMTE^XLFDT(+TIULAST,"1P") G NOTESX
- W !,">> "_CTR_" note"_$S(CTR>1:"s",1:"")_" found for "_$P(TIULOC,U,3)
- I CTR'>1 S TIUSPG=1
- E S TIUSPG=$$PAGE^TIUPRPN3 G:TIUSPG']"" NOTESX S TIUSPG=$S(+$G(TIUSPG):0,1:1)
- 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
- W ! S %ZIS="Q" D ^%ZIS I POP K POP G EXIT
- I $E(IOST)="C" W $C(7),$C(7),!?5,"You must select a "
- I W "printer for this option!!" G DEV
- S $P(^TIU(8925.93,$P(TIULOC,U,2),0),U,4)=""
- I $D(IO("Q")) K IO("Q") D G EXIT
- .S ZTRTN="PRINT^TIUPRPN5",ZTSAVE("^TMP(""TIUPR"",$J,")=""
- .S ZTSAVE("TIUSPG")="",ZTSAVE("TIULAST")="",ZTSAVE("TIULOC")=""
- .S ZTDESC="TIU PRT PNS BY LOCATION"
- .D ^%ZTLOAD W !,$S($D(ZTSK):"Request Queued!",1:"Request Canceled!")
- .K ZTSK,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,%ZIS,TIULAST,TIUSPG,TIULOC
- .D HOME^%ZIS
- U IO D PRINT,^%ZISC
- NOTESX ;
- K ^TMP("TIUREPLACE",$J)
- Q
- PRINT ;
- K ^TMP("TIULQ",$J)
- I $D(ZTQUEUED) S ZTREQ="@"
- D PRINT^TIUPRPN1(1,$G(TIUSPG))
- S $P(^TIU(8925.93,$P(TIULOC,U,2),1),U,2)=TIULAST
- EXIT K ^TMP("TIULQ",$J),^TMP("TIUPR",$J),^TMP("TIUREPLACE",$J)
- Q
- ;
- 1 W !!,"I don't seem to have any record of you having used this option "
- W !,"to print progress notes for this location.",!
- Q
- 2 W !!,"I could not determine what the last note printed for this "
- W !,"location was."
- W !!,"Please select a date and all notes from that date to NOW will be"
- W !,"printed. The last note printed will become the new base date.",!
- Q
- 3 W !!,"OK- then select a different date.",!
- Q
- HELP ; help for continue from this point prompt
- W !!,"Every note that has been signed since this date (last time this"
- W !,"notes were printed using this option) until NOW will be printed."
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIUPRPN5 4634 printed Mar 13, 2025@21:48:44 Page 2
- TIUPRPN5 ;SLC/MJC-Sort PNs for Prting by Location;6/26/01
- +1 ;;1.0;TEXT INTEGRATION UTILITIES;**100,121**;Jun 20, 1997
- +2 ;
- LOC ;sorts PNs for prting by CLINIC location
- +1 ;these notes are chartable contiguous or separate
- +2 ;this option is screened to exclude WARDs
- +3 ;sites should use the [TIU PRINT PN WARD] option which sorts
- +4 ;by BED NUMBER for current inpts on that ward for INPT notes
- +5 ;[TIU PRINT PN OUTPT LOC]
- +6 ;
- +7 NEW DIC,Y,TIUQT,TIULOC
- +8 DO SETUP^TIUPRPN3("Print Progress Notes for OUTPATIENT LOCATION")
- DIC FOR
- Begin DoDot:1
- +1 SET DIC=8925.93
- SET DIC(0)="AEQMNZ"
- SET DIC("A")="Select OUTPATIENT location: "
- +2 SET DIC("S")="I $P($G(^SC(+$P($G(^TIU(8925.93,+Y,0)),U),0)),U,3)'=""W"""
- +3 WRITE !
- DO ^DIC
- KILL DIC("S")
- IF Y<0
- SET TIUQT=1
- QUIT
- +4 SET TIULOC=+Y(0)_U_+Y_U_Y(0,0)
- +5 IF '$DATA(^TIU(8925,"ALOCP",+TIULOC))
- Begin DoDot:2
- +6 WRITE !,$CHAR(7),"There are no signed Progress Notes for this location!!"
- End DoDot:2
- QUIT
- +7 DO NOTES(TIULOC)
- End DoDot:1
- if $DATA(TIUQT)
- QUIT
- +8 QUIT
- +9 ;
- NOTES(TIULOC) ;returns date/time;ien of last note prted
- +1 NEW OLD,NEW,Y,BEG,IFN,TIUSPG,CTR,TIULAST,ANS,MSG,TIUQT,DFN,SORT
- +2 KILL ^TMP("TIUREPLACE",$JOB)
- +3 SET MSG=1
- SET TIULAST=$PIECE($GET(^TIU(8925.93,+$PIECE(TIULOC,U,2),1)),U,2)
- +4 IF TIULAST]""
- Begin DoDot:1
- +5 IF '+$GET(TIULAST)!'$PIECE(TIULAST,";",2)!('$DATA(^TIU(8925,"ALOCP",+TIULOC,+TIULAST,+$PIECE(TIULAST,";",2))))
- SET $PIECE(^TIU(8925.93,+$PIECE(TIULOC,U,2),1),U,2)=""
- SET MSG=2
- QUIT
- +6 SET BEG=+TIULAST
- +7 WRITE !!,"The last note printed for this location using this option was "
- +8 WRITE !,"signed ",$$FMTE^XLFDT(BEG,"1P"),!!
- +9 SET ANS=$$READ^TIUU("YA","Print from this point on? ","YES","^D HELP^TIUPRPN5")
- +10 IF $DATA(DIRUT)
- SET TIUQT=1
- QUIT
- +11 IF +$GET(ANS)
- SET IFN=$PIECE(TIULAST,U,2)
- QUIT
- +12 SET $PIECE(^TIU(8925.93,+$PIECE(TIULOC,U,2),1),U,2)=""
- SET MSG=3
- End DoDot:1
- if $DATA(TIUQT)
- QUIT
- +13 IF $PIECE($GET(^TIU(8925.93,+$PIECE(TIULOC,U,2),1)),U,2)']""
- Begin DoDot:1
- +14 ;writes message to explain date selection
- DO @MSG
- RANGE SET OLD=$ORDER(^TIU(8925,"ALOCP",+TIULOC,0))
- +1 SET NEW=$ORDER(^TIU(8925,"ALOCP",+TIULOC,9999999),-1)
- +2 WRITE !," The OLDEST note was signed: ",$$FMTE^XLFDT(OLD,"1P")
- +3 WRITE !,"The MOST RECENT note was signed: ",$$FMTE^XLFDT(NEW,"1P"),!
- +4 WRITE !,"Select a date and I will print all signed notes for "
- +5 WRITE !,$PIECE(TIULOC,U,3)," from this date until NOW.",!
- DATE SET %DT="AEPX"
- SET %DT(0)="-NOW"
- SET %DT("A")="Print Notes Beginning: "
- +1 DO ^%DT
- KILL %DT
- IF $DATA(DTOUT)!(Y<0)
- SET TIUQT=1
- QUIT
- +2 IF Y>NEW
- WRITE $CHAR(7),!?5,"Pick a date between the OLDEST and the MOST "
- +3 IF $TEST
- WRITE "RECENT."
- GOTO DATE
- +4 SET BEG=Y
- End DoDot:1
- if $DATA(TIUQT)
- QUIT
- +5 SET CTR=0
- FOR
- SET BEG=$ORDER(^TIU(8925,"ALOCP",+TIULOC,BEG))
- if 'BEG
- QUIT
- Begin DoDot:1
- +6 IF '$DATA(IFN)
- SET IFN=0
- +7 FOR
- SET IFN=$ORDER(^TIU(8925,"ALOCP",+TIULOC,BEG,IFN))
- if 'IFN
- QUIT
- Begin DoDot:2
- +8 WRITE "."
- DO REPLACE^TIUPRPN3(IFN,BEG,1501)
- End DoDot:2
- End DoDot:1
- +9 SET IFN=0
- FOR
- SET IFN=$ORDER(^TMP("TIUREPLACE",$JOB,IFN))
- if 'IFN
- QUIT
- Begin DoDot:1
- +10 SET DFN=$PIECE(^TIU(8925,IFN,0),U,2)
- SET SORT=$PIECE(^DPT(DFN,0),U)_";"_DFN
- +11 SET BEG=^TMP("TIUREPLACE",$JOB,IFN,"DT")
- +12 SET ^TMP("TIUPR",$JOB,SORT,BEG,IFN)="Vice SF 509"
- +13 SET TIULAST=BEG_";"_IFN
- End DoDot:1
- +14 SET CTR=+$GET(^TMP("TIUREPLACE",$JOB))
- +15 IF CTR=0
- WRITE $CHAR(7),!!,"No notes have been signed for this location since "
- +16 IF $TEST
- WRITE $$FMTE^XLFDT(+TIULAST,"1P")
- GOTO NOTESX
- +17 WRITE !,">> "_CTR_" note"_$SELECT(CTR>1:"s",1:"")_" found for "_$PIECE(TIULOC,U,3)
- +18 IF CTR'>1
- SET TIUSPG=1
- +19 IF '$TEST
- SET TIUSPG=$$PAGE^TIUPRPN3
- if TIUSPG']""
- GOTO NOTESX
- SET TIUSPG=$SELECT(+$GET(TIUSPG):0,1:1)
- DEV ;brings up default prter from param file
- SET %ZIS("B")=$PIECE($GET(^%ZIS(1,+$PIECE($GET(^TIU(8925.93,$PIECE(TIULOC,U,2),1)),U,3),0),""),U)
- +1 WRITE !
- SET %ZIS="Q"
- DO ^%ZIS
- IF POP
- KILL POP
- GOTO EXIT
- +2 IF $EXTRACT(IOST)="C"
- WRITE $CHAR(7),$CHAR(7),!?5,"You must select a "
- +3 IF $TEST
- WRITE "printer for this option!!"
- GOTO DEV
- +4 SET $PIECE(^TIU(8925.93,$PIECE(TIULOC,U,2),0),U,4)=""
- +5 IF $DATA(IO("Q"))
- KILL IO("Q")
- Begin DoDot:1
- +6 SET ZTRTN="PRINT^TIUPRPN5"
- SET ZTSAVE("^TMP(""TIUPR"",$J,")=""
- +7 SET ZTSAVE("TIUSPG")=""
- SET ZTSAVE("TIULAST")=""
- SET ZTSAVE("TIULOC")=""
- +8 SET ZTDESC="TIU PRT PNS BY LOCATION"
- +9 DO ^%ZTLOAD
- WRITE !,$SELECT($DATA(ZTSK):"Request Queued!",1:"Request Canceled!")
- +10 KILL ZTSK,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,%ZIS,TIULAST,TIUSPG,TIULOC
- +11 DO HOME^%ZIS
- End DoDot:1
- GOTO EXIT
- +12 USE IO
- DO PRINT
- DO ^%ZISC
- NOTESX ;
- +1 KILL ^TMP("TIUREPLACE",$JOB)
- +2 QUIT
- PRINT ;
- +1 KILL ^TMP("TIULQ",$JOB)
- +2 IF $DATA(ZTQUEUED)
- SET ZTREQ="@"
- +3 DO PRINT^TIUPRPN1(1,$GET(TIUSPG))
- +4 SET $PIECE(^TIU(8925.93,$PIECE(TIULOC,U,2),1),U,2)=TIULAST
- EXIT KILL ^TMP("TIULQ",$JOB),^TMP("TIUPR",$JOB),^TMP("TIUREPLACE",$JOB)
- +1 QUIT
- +2 ;
- 1 WRITE !!,"I don't seem to have any record of you having used this option "
- +1 WRITE !,"to print progress notes for this location.",!
- +2 QUIT
- 2 WRITE !!,"I could not determine what the last note printed for this "
- +1 WRITE !,"location was."
- +2 WRITE !!,"Please select a date and all notes from that date to NOW will be"
- +3 WRITE !,"printed. The last note printed will become the new base date.",!
- +4 QUIT
- 3 WRITE !!,"OK- then select a different date.",!
- +1 QUIT
- HELP ; help for continue from this point prompt
- +1 WRITE !!,"Every note that has been signed since this date (last time this"
- +2 WRITE !,"notes were printed using this option) until NOW will be printed."
- +3 QUIT
