[613] | 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 | ;
|
---|