| 1 | NURCROP2 ;HIRMFO/RM-CARE PLAN RANK ORDER PRINT ;12/23/93
 | 
|---|
| 2 |  ;;4.0;NURSING SERVICE;;Apr 25, 1997
 | 
|---|
| 3 | PRINT ; ENTRY FROM NURCROP0 TO PRINT THIS REPORT
 | 
|---|
| 4 |  ;
 | 
|---|
| 5 |  ;  RANK=0
 | 
|---|
| 6 |  ;  Loop through ^TMP($J,"NURSPR",FREQ,PROBLEM) increasing RANK with
 | 
|---|
| 7 |  ;  each new FREQ
 | 
|---|
| 8 |  ;    BEGIN
 | 
|---|
| 9 |  S (NURCOUT,NURCRANK)=0
 | 
|---|
| 10 |  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
 | 
|---|
| 11 |  .;      WRTPROB(RANK,PROBLEM,FREQ)
 | 
|---|
| 12 |  .;      RANK1=0
 | 
|---|
| 13 |  .;      Loop through ^TMP($J,"NURSPROB",PROBLEM,BS5)
 | 
|---|
| 14 |  .;        WRTPPT(BS5)
 | 
|---|
| 15 |  .;      Loop through ^TMP($J,"NURSIR",PR,FREQ1,ORD) increasing RANK1 by
 | 
|---|
| 16 |  .;      one for each new FREQ
 | 
|---|
| 17 |  .;        BEGIN
 | 
|---|
| 18 |  .S NURCRNK1=0,NURCOUT=$$WRTPROB^NURCROP1(NURCRANK,NURCPTRM,9999999-NURCFREQ) Q:NURCOUT
 | 
|---|
| 19 |  .W !?15 S NURCBS5="" F  S NURCBS5=$O(^TMP($J,"NURSPROB",NURCPTRM,NURCBS5)) Q:NURCBS5=""  S NURCOUT=$$WRTPPT^NURCROP1(NURCBS5) Q:NURCOUT
 | 
|---|
| 20 |  .S NURCOUT=$$HDRINT^NURCROP1 Q:NURCOUT
 | 
|---|
| 21 |  .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
 | 
|---|
| 22 |  ..;          WRTORD(RANK1,ORD,FREQ1)
 | 
|---|
| 23 |  ..;          Loop through ^TMP($J,"NURSORD",PROBLEM,ORD,BS5)
 | 
|---|
| 24 |  ..;            WRTOPT(BS5)
 | 
|---|
| 25 |  ..S NURCOUT=$$WRTORD^NURCROP1(NURCRNK1,NURCOTRM,9999999-NURCFRQ1) Q:NURCOUT
 | 
|---|
| 26 |  ..W !?20 S NURCBS5="" F  S NURCBS5=$O(^TMP($J,"NURSORD",NURCPTRM,NURCOTRM,NURCBS5)) Q:NURCBS5=""  S NURCOUT=$$WRTOPT^NURCROP1(NURCBS5) Q:NURCOUT
 | 
|---|
| 27 |  .;        END
 | 
|---|
| 28 |  ;    END
 | 
|---|
| 29 |  ;
 | 
|---|
| 30 |  ;  If terminal don't let last page scroll off of screen
 | 
|---|
| 31 |  S NURCPAGE=$$HEADER^NURCROP1(-1)
 | 
|---|
| 32 |  Q
 | 
|---|
| 33 | SORTYP() ; Function that returns:
 | 
|---|
| 34 |  ;    1 = sort by admitting location
 | 
|---|
| 35 |  ;    2 = sort by all locations during patient stay
 | 
|---|
| 36 |  ;    0 = user did not select location
 | 
|---|
| 37 |  ;   -1 = user abnormally exited.
 | 
|---|
| 38 |  N DTOUT,DUOUT
 | 
|---|
| 39 |  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: "
 | 
|---|
| 40 |  S DIR("?")="ENTER A CHOICE FROM LIST, EITHER 1 OR 2",DIR(0)="NOA^1:2" D ^DIR
 | 
|---|
| 41 |  Q $S(Y=1!(Y=2):Y,$D(DTOUT)!$D(DUOUT):-1,1:0)
 | 
|---|
| 42 |  ;
 | 
|---|
| 43 | RPRTID() ;  Select the Ward/Group Report ID for the header
 | 
|---|
| 44 |  N NURCLID
 | 
|---|
| 45 |  S NURCLID=$O(NURSNLOC(""))
 | 
|---|
| 46 |  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
 | 
|---|
| 47 |  E  I $O(NURSNLOC(NURCLID))="" D
 | 
|---|
| 48 |  .   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=""
 | 
|---|
| 49 |  .   D ^DIR I '$D(DIRUT) S NURCLID=Y K DIR
 | 
|---|
| 50 |  .   Q
 | 
|---|
| 51 |  Q NURCLID
 | 
|---|
| 52 |  ;
 | 
|---|