NURCROP2 ;HIRMFO/RM-CARE PLAN RANK ORDER PRINT ;12/23/93
;;4.0;NURSING SERVICE;;Apr 25, 1997
PRINT ; ENTRY FROM NURCROP0 TO PRINT THIS REPORT
;
; RANK=0
; Loop through ^TMP($J,"NURSPR",FREQ,PROBLEM) increasing RANK with
; each new FREQ
; BEGIN
S (NURCOUT,NURCRANK)=0
F NURCFREQ=0:0 S NURCFREQ=$O(^TMP($J,"NURSPR",NURCFREQ)),NURCRANK=NURCRANK+1 Q:NURCFREQ'>0!NURCOUT F NURCPTRM=0:0 S NURCPTRM=$O(^TMP($J,"NURSPR",NURCFREQ,NURCPTRM)) Q:NURCPTRM'>0!NURCOUT D
.; WRTPROB(RANK,PROBLEM,FREQ)
.; RANK1=0
.; Loop through ^TMP($J,"NURSPROB",PROBLEM,BS5)
.; WRTPPT(BS5)
.; Loop through ^TMP($J,"NURSIR",PR,FREQ1,ORD) increasing RANK1 by
.; one for each new FREQ
.; BEGIN
.S NURCRNK1=0,NURCOUT=$$WRTPROB^NURCROP1(NURCRANK,NURCPTRM,9999999-NURCFREQ) Q:NURCOUT
.W !?15 S NURCBS5="" F S NURCBS5=$O(^TMP($J,"NURSPROB",NURCPTRM,NURCBS5)) Q:NURCBS5="" S NURCOUT=$$WRTPPT^NURCROP1(NURCBS5) Q:NURCOUT
.S NURCOUT=$$HDRINT^NURCROP1 Q:NURCOUT
.F NURCFRQ1=0:0 S NURCFRQ1=$O(^TMP($J,"NURSIR",NURCPTRM,NURCFRQ1)),NURCRNK1=NURCRNK1+1 Q:NURCFRQ1'>0!NURCOUT F NURCOTRM=0:0 S NURCOTRM=$O(^TMP($J,"NURSIR",NURCPTRM,NURCFRQ1,NURCOTRM)) Q:NURCOTRM'>0!NURCOUT D
..; WRTORD(RANK1,ORD,FREQ1)
..; Loop through ^TMP($J,"NURSORD",PROBLEM,ORD,BS5)
..; WRTOPT(BS5)
..S NURCOUT=$$WRTORD^NURCROP1(NURCRNK1,NURCOTRM,9999999-NURCFRQ1) Q:NURCOUT
..W !?20 S NURCBS5="" F S NURCBS5=$O(^TMP($J,"NURSORD",NURCPTRM,NURCOTRM,NURCBS5)) Q:NURCBS5="" S NURCOUT=$$WRTOPT^NURCROP1(NURCBS5) Q:NURCOUT
.; END
; END
;
; If terminal don't let last page scroll off of screen
S NURCPAGE=$$HEADER^NURCROP1(-1)
Q
SORTYP() ; Function that returns:
; 1 = sort by admitting location
; 2 = sort by all locations during patient stay
; 0 = user did not select location
; -1 = user abnormally exited.
N DTOUT,DUOUT
K DIR S DIR("A",1)="Would you like statistics by:",DIR("A",2)=" 1. Admitting Location for a particular admission",DIR("A",3)=" 2. All Locations the Patient was on during a particular admission.",DIR("A")="Choose 1 or 2: "
S DIR("?")="ENTER A CHOICE FROM LIST, EITHER 1 OR 2",DIR(0)="NOA^1:2" D ^DIR
Q $S(Y=1!(Y=2):Y,$D(DTOUT)!$D(DUOUT):-1,1:0)
;
RPRTID() ; Select the Ward/Group Report ID for the header
N NURCLID
S NURCLID=$O(NURSNLOC(""))
I $O(NURSNLOC(NURCLID))'="" W ! K DIR S NURCLID="",DIR(0)="FA^2:30",DIR("A")="REPORT IDENTIFIER: ",DIR("?")="This is a free text prompt printed in the header to identify this report" D ^DIR I '$D(DIRUT) S NURCLID=Y K DIR
E I $O(NURSNLOC(NURCLID))="" D
. S NURCLID=$O(NURSNLOC("")) W ! K DIR S DIR(0)="FA^2:30",DIR("A")="REPORT IDENTIFIER: ",DIR("B")=NURCLID,DIR("?")="This is a free text prompt printed in the header to identify this report",NURCLID=""
. D ^DIR I '$D(DIRUT) S NURCLID=Y K DIR
. Q
Q NURCLID
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HNURCROP2 2910 printed Dec 13, 2024@02:20:55 Page 2
NURCROP2 ;HIRMFO/RM-CARE PLAN RANK ORDER PRINT ;12/23/93
+1 ;;4.0;NURSING SERVICE;;Apr 25, 1997
PRINT ; ENTRY FROM NURCROP0 TO PRINT THIS REPORT
+1 ;
+2 ; RANK=0
+3 ; Loop through ^TMP($J,"NURSPR",FREQ,PROBLEM) increasing RANK with
+4 ; each new FREQ
+5 ; BEGIN
+6 SET (NURCOUT,NURCRANK)=0
+7 FOR NURCFREQ=0:0
SET NURCFREQ=$ORDER(^TMP($JOB,"NURSPR",NURCFREQ))
SET NURCRANK=NURCRANK+1
if NURCFREQ'>0!NURCOUT
QUIT
FOR NURCPTRM=0:0
SET NURCPTRM=$ORDER(^TMP($JOB,"NURSPR",NURCFREQ,NURCPTRM))
if NURCPTRM'>0!NURCOUT
QUIT
Begin DoDot:1
+8 ; WRTPROB(RANK,PROBLEM,FREQ)
+9 ; RANK1=0
+10 ; Loop through ^TMP($J,"NURSPROB",PROBLEM,BS5)
+11 ; WRTPPT(BS5)
+12 ; Loop through ^TMP($J,"NURSIR",PR,FREQ1,ORD) increasing RANK1 by
+13 ; one for each new FREQ
+14 ; BEGIN
+15 SET NURCRNK1=0
SET NURCOUT=$$WRTPROB^NURCROP1(NURCRANK,NURCPTRM,9999999-NURCFREQ)
if NURCOUT
QUIT
+16 WRITE !?15
SET NURCBS5=""
FOR
SET NURCBS5=$ORDER(^TMP($JOB,"NURSPROB",NURCPTRM,NURCBS5))
if NURCBS5=""
QUIT
SET NURCOUT=$$WRTPPT^NURCROP1(NURCBS5)
if NURCOUT
QUIT
+17 SET NURCOUT=$$HDRINT^NURCROP1
if NURCOUT
QUIT
+18 FOR NURCFRQ1=0:0
SET NURCFRQ1=$ORDER(^TMP($JOB,"NURSIR",NURCPTRM,NURCFRQ1))
SET NURCRNK1=NURCRNK1+1
if NURCFRQ1'>0!NURCOUT
QUIT
FOR NURCOTRM=0:0
SET NURCOTRM=$ORDER(^TMP($JOB,"NURSIR",NURCPTRM,NURCFRQ1,NURCOTRM))
if NURCOTRM'>0!NURCOUT
QUIT
Begin DoDot:2
+19 ; WRTORD(RANK1,ORD,FREQ1)
+20 ; Loop through ^TMP($J,"NURSORD",PROBLEM,ORD,BS5)
+21 ; WRTOPT(BS5)
+22 SET NURCOUT=$$WRTORD^NURCROP1(NURCRNK1,NURCOTRM,9999999-NURCFRQ1)
if NURCOUT
QUIT
+23 WRITE !?20
SET NURCBS5=""
FOR
SET NURCBS5=$ORDER(^TMP($JOB,"NURSORD",NURCPTRM,NURCOTRM,NURCBS5))
if NURCBS5=""
QUIT
SET NURCOUT=$$WRTOPT^NURCROP1(NURCBS5)
if NURCOUT
QUIT
End DoDot:2
+24 ; END
End DoDot:1
+25 ; END
+26 ;
+27 ; If terminal don't let last page scroll off of screen
+28 SET NURCPAGE=$$HEADER^NURCROP1(-1)
+29 QUIT
SORTYP() ; Function that returns:
+1 ; 1 = sort by admitting location
+2 ; 2 = sort by all locations during patient stay
+3 ; 0 = user did not select location
+4 ; -1 = user abnormally exited.
+5 NEW DTOUT,DUOUT
+6 KILL DIR
SET DIR("A",1)="Would you like statistics by:"
SET DIR("A",2)=" 1. Admitting Location for a particular admission"
SET DIR("A",3)=" 2. All Locations the Patient was on during a particular admission."
SET DIR("A")="Choose 1 or 2: "
+7 SET DIR("?")="ENTER A CHOICE FROM LIST, EITHER 1 OR 2"
SET DIR(0)="NOA^1:2"
DO ^DIR
+8 QUIT $SELECT(Y=1!(Y=2):Y,$DATA(DTOUT)!$DATA(DUOUT):-1,1:0)
+9 ;
RPRTID() ; Select the Ward/Group Report ID for the header
+1 NEW NURCLID
+2 SET NURCLID=$ORDER(NURSNLOC(""))
+3 IF $ORDER(NURSNLOC(NURCLID))'=""
WRITE !
KILL DIR
SET NURCLID=""
SET DIR(0)="FA^2:30"
SET DIR("A")="REPORT IDENTIFIER: "
SET DIR("?")="This is a free text prompt printed in the header to identify this report"
DO ^DIR
IF '$DATA(DIRUT)
SET NURCLID=Y
KILL DIR
+4 IF '$TEST
IF $ORDER(NURSNLOC(NURCLID))=""
Begin DoDot:1
+5 SET NURCLID=$ORDER(NURSNLOC(""))
WRITE !
KILL DIR
SET DIR(0)="FA^2:30"
SET DIR("A")="REPORT IDENTIFIER: "
SET DIR("B")=NURCLID
SET DIR("?")="This is a free text prompt printed in the header to identify this report"
SET NURCLID=""
+6 DO ^DIR
IF '$DATA(DIRUT)
SET NURCLID=Y
KILL DIR
+7 QUIT
End DoDot:1
+8 QUIT NURCLID
+9 ;
