64 lines
3.3 KiB
Mathematica
64 lines
3.3 KiB
Mathematica
NURCROP1 ;HIRMFO/RM,RTK-RANK ORDER PRINT (CONT.) ;8/29/96
|
|
;;4.0;NURSING SERVICE;;Apr 25, 1997
|
|
HEADER(PG) ; FUNCTION PRINTS HEADER FOR NEXT PAGE
|
|
; FUNCTION VALUE IS THE NUMBER OF NEW PAGE, -1 IF ABNORMAL USER EXIT
|
|
N DIR,X,Y I PG>0,$E(IOST)="C" W ! D ENDPG^NURSUT1 I $G(NUROUT) S PG=-1 G RETURN
|
|
W:$E(IOST)="C"!(PG>1) @IOF
|
|
S PG=PG+1 W !,"RANK LISTING OF PATIENT PROBLEMS",?71,"PAGE",$J(PG,3)
|
|
I PG'<0 S Y=NURCBGDT\1 D DD^%DT W !,"From: ",Y S Y=NURCENDT\1 D DD^%DT W " to: ",Y W !!,"Rank Freq Problem" I NURCLID'="" W " Report Identifier: ",NURCLID
|
|
I PG'<0 W !,"=============================================================================="
|
|
RETURN Q PG
|
|
HDRINT() ; PRINTS HEADER FOR INTERVENTIONS UNDER A PROBLEM
|
|
; FUNCTION VALUE IS 1 IF ABNORMAL USER END, ELSE 0
|
|
N WRT S WRT=1 I IOSL-8<$Y S NURCPAGE=$$HEADER(NURCPAGE) I NURCPAGE<0 S WRT=0
|
|
I WRT W !?5,"Rank Freq Intervention",!?5,"---- ---- ------------"
|
|
Q 'WRT
|
|
WRTPROB(RANK,PROB,FREQ) ; WRITES OUT LINE FOR PROBLEM, CHECKS FOR HEADER PRINT
|
|
; FUNCTION VALUE IS 1 IF ABNORMAL USER END, ELSE 0
|
|
N WRT S WRT=1 I IOSL-7<$Y S NURCPAGE=$$HEADER(NURCPAGE) I NURCPAGE<0 S WRT=0
|
|
I WRT W !!,$J(RANK,3),?5,$J(FREQ,4),?11,$P($G(^GMRD(124.2,+PROB,0)),"^")
|
|
Q 'WRT
|
|
WRTORD(RANK,ORD,FREQ) ; WRITES OUT LINE FOR ORDERABLE, CHECKS FOR HDR PRINT
|
|
; FUNCTION VALUE IS 1 IF ABNORMAL USER EXIT, ELSE 0
|
|
N WRT S WRT=1 I IOSL-6<$Y S NURCPAGE=$$HEADER(NURCPAGE) I NURCPAGE<0 S WRT=0
|
|
I WRT W !?5,$J(RANK,3),?10,$J(FREQ,4),?16,$P($G(^GMRD(124.2,+ORD,0)),"^")
|
|
Q 'WRT
|
|
WRTOPT(BS5) ; WRITES OUT LINE FOR PATIENTS UNDER ORDERABLE, CHECKS FOR HDR
|
|
; FUNCTION VALUE IS 1 IF ABNORMAL USER END, ELSE 0
|
|
N WRT S WRT=1 I IOM-8<$X S:IOSL-6<$Y NURCPAGE=$$HEADER(NURCPAGE) S:NURCPAGE<0 WRT=0 W:WRT !?20
|
|
I WRT W BS5,","
|
|
Q 'WRT
|
|
WRTPPT(BS5) ; WRITES OUT LINE FOR PATIENTS UNDER PROBLEM, CHECKS FOR HDR
|
|
; FUNCTION VALUE IS 1 IF ABNORMAL USER END, ELSE 0
|
|
N WRT S WRT=1 I IOM-8<$X S:IOSL-6<$Y NURCPAGE=$$HEADER(NURCPAGE) S:NURCPAGE<0 WRT=0 W:WRT !?15
|
|
I WRT W BS5,","
|
|
Q 'WRT
|
|
ACTIVE(PR,NCP,BDT,EDT) ;
|
|
; FUNCTION VALUE IS 0 IF THIS PROBLEM IS ACTIVE OVER DATE/TIME RANGE
|
|
; BGD-EDT, ELSE VALUE IS 1
|
|
N ACTIVE,NNCP,X,Y S ACTIVE=1
|
|
S NNCP=$O(^NURSC(216.8,"B",NCP,0)) S:NNCP'>0!'$$PROBLEM(PR) ACTIVE=0
|
|
I ACTIVE S ACTIVE=0 F X=(9999999-EDT):0 S X=$O(^NURSC(216.8,NNCP,"EVAL","AA",PR,X)) Q:X'>0 S Y=$O(^NURSC(216.8,NNCP,"EVAL","AA",PR,X,0)) I Y S Y=$G(^NURSC(216.8,NNCP,"EVAL",Y,0)) S ACTIVE='(+Y<BDT&$P(Y,"^",4)) Q
|
|
Q ACTIVE
|
|
PROBLEM(AGGY) ;
|
|
; FUNCTION VALUE IS 1 IF AGGY HAS CLASS OF NURSING PROBLEM, ELSE
|
|
; RETURNS 0.
|
|
N CLAS,PROBLEM S PROBLEM=1
|
|
S CLAS=$O(^GMRD(124.25,"AA","NURSC","NURSING PROBLEM",0)) S:'CLAS PROBLEM=0
|
|
I PROBLEM S PROBLEM=($P($G(^GMRD(124.2,AGGY,0)),"^",4)=CLAS)
|
|
Q PROBLEM
|
|
GETTRM(PR,CLAS) ;
|
|
; GETS FIRST TERM ENCOUNTERED IN TREE WITH PR AS ROOT WITH CLASS.=CLAS
|
|
N A,B,C,D,E
|
|
S A=PR,E=0 D RECUR1
|
|
Q E
|
|
RECUR1 N D,B F B=0:0 S B=$O(^GMRD(124.2,A,1,B)) Q:B'>0 S C=+$G(^GMRD(124.2,A,1,B,0)) I '$P(C,"^",6),+C S D=$G(^GMRD(124.2,C,0)) S:$P(D,"^",4)=CLAS E=C Q:E S D=A,A=C D RECUR1 S A=D Q:E
|
|
Q
|
|
GETLST(PR,CLAS) ; GETS LIST OF TERMS IN TREE WITH PR AS ROOT WITH CLASS.=CLAS
|
|
; FUNCTION RETURNS 1 IF LIST NOT EMPTY, ELSE RETURNS 0.
|
|
N A,B,C,D K NURSLIST
|
|
S A=PR D RECUR
|
|
Q ''$D(NURSLIST)
|
|
RECUR N D,B F B=0:0 S B=$O(^GMRD(124.2,A,1,B)) Q:B'>0 S C=+$G(^GMRD(124.2,A,1,B,0)) I '$P(C,"^",6),+C S D=$G(^GMRD(124.2,C,0)) S:$P(D,"^",4)=CLAS NURSLIST(C)="" S D=A,A=C D RECUR S A=D
|
|
Q
|