- 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
- ;
- 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 ;
