- TIUPRPN4 ;SLC/MJC;Print Progress Notes for Inpt Location; 6/26/01
- ;;1.0;TEXT INTEGRATION UTILITIES;**25,100,121**;Jun 20, 1997
- ;
- LOC ;sorts PNs for prting by WARD location
- ;this option is for inpts
- ;it prts all PNs for a selected date range for all patients
- ;currently on the WARD
- ;these notes are chartable contiguous or separate
- ;[TIU PRINT PN WARD]
- ;
- N DIC,Y,TIUQT,TIULOC,WARD
- D SETUP^TIUPRPN3("Print Progress Notes for ALL patients on WARD")
- DIC F D Q:$D(TIUQT)
- .S DIC=8925.93,DIC(0)="AEQMNZ",DIC("A")="Select WARD 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 I Y<0 S TIUQT=1 Q
- .S WARD=Y(0,0)
- .I '+$O(^DIC(42,"B",WARD,0)) D
- ..S WARD=$P($G(^DIC(42,+$G(^SC(+$P(Y,U,2),42)),0)),U)
- .I '+$O(^DIC(42,"B",WARD,0)) D Q
- ..S TIUQT=1
- ..W !!,"Invalid WARD LOCATION...Contact IRM."
- .S TIULOC=+Y(0)_U_+Y_U_Y(0,0)
- .;ien hosp loc^ien tiu prt param^external ward loc
- .D NOTES(TIULOC)
- Q
- ;
- NOTES(TIULOC) ;sets date/time of when notes prted
- N Y,BEG,MOVE,BED,DATE,CTR,TIULAST,ANS,IFN,TIUSPG,DFN,TIUQT
- K ^TMP("TIUREPLACE",$J)
- S TIULAST=$P($G(^TIU(8925.93,+$P(TIULOC,U,2),1)),U,2)
- I TIULAST']"" S BEG=$$DATE() Q:BEG']""
- I TIULAST]"" D Q:$D(TIUQT)
- .I '+$G(TIULAST) D 2^TIUPRPN5 S BEG=$$DATE() I BEG']"" S TIUQT=1 Q
- .W !!,"Notes were last printed for "_WARD_" at "
- .W $$FMTE^XLFDT(+TIULAST,"1P"),!
- .S ANS=$$READ^TIUU("YA","Print from this DATE/TIME on? ","YES","^D HELP^TIUPRPN5")
- .I $D(DIRUT) S TIUQT=1 Q
- .I +$G(ANS) S BEG=+TIULAST Q
- .D 3^TIUPRPN5 S BEG=$$DATE() I BEG']"" S TIUQT=1 Q
- S TIULAST=BEG
- S MOVE=0 F S MOVE=$O(^DGPM("CN",WARD,MOVE)) Q:'MOVE D
- .Q:'$D(^DGPM(MOVE,0))
- .S DFN=$P(^DGPM(MOVE,0),U,3)
- .S BEG=$E(TIULAST,1,12)-.0001 ;back up one minute
- .F S BEG=$O(^TIU(8925,"APTP",DFN,BEG)) Q:'BEG D
- ..S IFN=0 F S IFN=$O(^TIU(8925,"APTP",DFN,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),BED=$G(^DPT(DFN,.101))_" "
- .S BEG=^TMP("TIUREPLACE",$J,IFN,"DT")
- .S ^TMP("TIUPR",$J,BED_";"_DFN,BEG,IFN)="Vice SF 509"
- S CTR=+$G(^TMP("TIUREPLACE",$J))
- I CTR=0 W $C(7),!!,"No notes have been signed for "_WARD_" since "
- I W $$FMTE^XLFDT(TIULAST,"1P") G NOTESX
- W !,">> "_CTR_" note"_$S(CTR>1:"s",1:"")_" found for WARD "_WARD
- S TIUSPG=1,TIULAST=$$NOW^XLFDT
- D DEV^TIUPRPN5
- NOTESX ;
- K ^TMP("TIUREPLACE",$J)
- Q
- DATE() W ! S %DT="AESTPX",%DT(0)="-NOW"
- S %DT("A")="Print Notes Starting With (DATE/TIME): "
- D ^%DT K %DT
- S BEG=$S($D(DTOUT):"",Y<0:"",1:Y)
- Q BEG
- ;
- ADD ; enter/edit locations in file 8925.93
- N DA,DIC,DIE,DR,TIUQT,Y
- F W ! D Q:$D(TIUQT)
- .S (DIC,DLAYGO)=8925.93,DIC(0)="AEQMNL"
- .S DIC("A")="Select Clinic or Ward: "
- .D ^DIC I Y<0 S TIUQT=1 Q
- .S DIE=DIC,DA=+Y,DR="1.03;3" D ^DIE
- K DLAYGO
- Q
- ;
- DIV ; enter/edit division params in file 8925.94
- N DA,DIC,DIE,DR,TIUQT,Y
- F W ! D Q:$D(TIUQT)
- .S (DIC,DLAYGO)=8925.94,DIC(0)="AEQMNL"
- .S DIC("A")="Select Division for PNs Outpatient Batch Print: "
- .D ^DIC I Y<0 S TIUQT=1 Q
- .S DIE=DIC,DA=+Y,DR=".02;1.02" D ^DIE
- K DLAYGO
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIUPRPN4 3173 printed Jan 18, 2025@03:44:58 Page 2
- TIUPRPN4 ;SLC/MJC;Print Progress Notes for Inpt Location; 6/26/01
- +1 ;;1.0;TEXT INTEGRATION UTILITIES;**25,100,121**;Jun 20, 1997
- +2 ;
- LOC ;sorts PNs for prting by WARD location
- +1 ;this option is for inpts
- +2 ;it prts all PNs for a selected date range for all patients
- +3 ;currently on the WARD
- +4 ;these notes are chartable contiguous or separate
- +5 ;[TIU PRINT PN WARD]
- +6 ;
- +7 NEW DIC,Y,TIUQT,TIULOC,WARD
- +8 DO SETUP^TIUPRPN3("Print Progress Notes for ALL patients on WARD")
- DIC FOR
- Begin DoDot:1
- +1 SET DIC=8925.93
- SET DIC(0)="AEQMNZ"
- SET DIC("A")="Select WARD 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
- IF Y<0
- SET TIUQT=1
- QUIT
- +4 SET WARD=Y(0,0)
- +5 IF '+$ORDER(^DIC(42,"B",WARD,0))
- Begin DoDot:2
- +6 SET WARD=$PIECE($GET(^DIC(42,+$GET(^SC(+$PIECE(Y,U,2),42)),0)),U)
- End DoDot:2
- +7 IF '+$ORDER(^DIC(42,"B",WARD,0))
- Begin DoDot:2
- +8 SET TIUQT=1
- +9 WRITE !!,"Invalid WARD LOCATION...Contact IRM."
- End DoDot:2
- QUIT
- +10 SET TIULOC=+Y(0)_U_+Y_U_Y(0,0)
- +11 ;ien hosp loc^ien tiu prt param^external ward loc
- +12 DO NOTES(TIULOC)
- End DoDot:1
- if $DATA(TIUQT)
- QUIT
- +13 QUIT
- +14 ;
- NOTES(TIULOC) ;sets date/time of when notes prted
- +1 NEW Y,BEG,MOVE,BED,DATE,CTR,TIULAST,ANS,IFN,TIUSPG,DFN,TIUQT
- +2 KILL ^TMP("TIUREPLACE",$JOB)
- +3 SET TIULAST=$PIECE($GET(^TIU(8925.93,+$PIECE(TIULOC,U,2),1)),U,2)
- +4 IF TIULAST']""
- SET BEG=$$DATE()
- if BEG']""
- QUIT
- +5 IF TIULAST]""
- Begin DoDot:1
- +6 IF '+$GET(TIULAST)
- DO 2^TIUPRPN5
- SET BEG=$$DATE()
- IF BEG']""
- SET TIUQT=1
- QUIT
- +7 WRITE !!,"Notes were last printed for "_WARD_" at "
- +8 WRITE $$FMTE^XLFDT(+TIULAST,"1P"),!
- +9 SET ANS=$$READ^TIUU("YA","Print from this DATE/TIME on? ","YES","^D HELP^TIUPRPN5")
- +10 IF $DATA(DIRUT)
- SET TIUQT=1
- QUIT
- +11 IF +$GET(ANS)
- SET BEG=+TIULAST
- QUIT
- +12 DO 3^TIUPRPN5
- SET BEG=$$DATE()
- IF BEG']""
- SET TIUQT=1
- QUIT
- End DoDot:1
- if $DATA(TIUQT)
- QUIT
- +13 SET TIULAST=BEG
- +14 SET MOVE=0
- FOR
- SET MOVE=$ORDER(^DGPM("CN",WARD,MOVE))
- if 'MOVE
- QUIT
- Begin DoDot:1
- +15 if '$DATA(^DGPM(MOVE,0))
- QUIT
- +16 SET DFN=$PIECE(^DGPM(MOVE,0),U,3)
- +17 ;back up one minute
- SET BEG=$EXTRACT(TIULAST,1,12)-.0001
- +18 FOR
- SET BEG=$ORDER(^TIU(8925,"APTP",DFN,BEG))
- if 'BEG
- QUIT
- Begin DoDot:2
- +19 SET IFN=0
- FOR
- SET IFN=$ORDER(^TIU(8925,"APTP",DFN,BEG,IFN))
- if 'IFN
- QUIT
- Begin DoDot:3
- +20 WRITE "."
- DO REPLACE^TIUPRPN3(IFN,BEG,1501)
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +21 SET IFN=0
- FOR
- SET IFN=$ORDER(^TMP("TIUREPLACE",$JOB,IFN))
- if 'IFN
- QUIT
- Begin DoDot:1
- +22 SET DFN=$PIECE(^TIU(8925,IFN,0),U,2)
- SET BED=$GET(^DPT(DFN,.101))_" "
- +23 SET BEG=^TMP("TIUREPLACE",$JOB,IFN,"DT")
- +24 SET ^TMP("TIUPR",$JOB,BED_";"_DFN,BEG,IFN)="Vice SF 509"
- End DoDot:1
- +25 SET CTR=+$GET(^TMP("TIUREPLACE",$JOB))
- +26 IF CTR=0
- WRITE $CHAR(7),!!,"No notes have been signed for "_WARD_" since "
- +27 IF $TEST
- WRITE $$FMTE^XLFDT(TIULAST,"1P")
- GOTO NOTESX
- +28 WRITE !,">> "_CTR_" note"_$SELECT(CTR>1:"s",1:"")_" found for WARD "_WARD
- +29 SET TIUSPG=1
- SET TIULAST=$$NOW^XLFDT
- +30 DO DEV^TIUPRPN5
- NOTESX ;
- +1 KILL ^TMP("TIUREPLACE",$JOB)
- +2 QUIT
- DATE() WRITE !
- SET %DT="AESTPX"
- SET %DT(0)="-NOW"
- +1 SET %DT("A")="Print Notes Starting With (DATE/TIME): "
- +2 DO ^%DT
- KILL %DT
- +3 SET BEG=$SELECT($DATA(DTOUT):"",Y<0:"",1:Y)
- +4 QUIT BEG
- +5 ;
- ADD ; enter/edit locations in file 8925.93
- +1 NEW DA,DIC,DIE,DR,TIUQT,Y
- +2 FOR
- WRITE !
- Begin DoDot:1
- +3 SET (DIC,DLAYGO)=8925.93
- SET DIC(0)="AEQMNL"
- +4 SET DIC("A")="Select Clinic or Ward: "
- +5 DO ^DIC
- IF Y<0
- SET TIUQT=1
- QUIT
- +6 SET DIE=DIC
- SET DA=+Y
- SET DR="1.03;3"
- DO ^DIE
- End DoDot:1
- if $DATA(TIUQT)
- QUIT
- +7 KILL DLAYGO
- +8 QUIT
- +9 ;
- DIV ; enter/edit division params in file 8925.94
- +1 NEW DA,DIC,DIE,DR,TIUQT,Y
- +2 FOR
- WRITE !
- Begin DoDot:1
- +3 SET (DIC,DLAYGO)=8925.94
- SET DIC(0)="AEQMNL"
- +4 SET DIC("A")="Select Division for PNs Outpatient Batch Print: "
- +5 DO ^DIC
- IF Y<0
- SET TIUQT=1
- QUIT
- +6 SET DIE=DIC
- SET DA=+Y
- SET DR=".02;1.02"
- DO ^DIE
- End DoDot:1
- if $DATA(TIUQT)
- QUIT
- +7 KILL DLAYGO
- +8 QUIT