29 lines
1.5 KiB
Mathematica
29 lines
1.5 KiB
Mathematica
NURARCR1 ;HIRMFO/MD,FT-CONTINUATION VIEW PRINT OF PATIENT CLASSIFICATION ;8/9/96 11:32
|
|
;;4.0;NURSING SERVICE;;Apr 25, 1997
|
|
WRITE S NL1="" F S NL1=$O(^TMP($J,NL1)) Q:NL1="" D HEADER:NURSW1,W1 Q:NURQUIT
|
|
Q
|
|
W1 S NDT="" F S NDT=$O(^TMP($J,NL1,NDT)) Q:NDT="" D W2 Q:NURQUIT
|
|
Q
|
|
W2 F DA(1)=0:0 S DA(1)=$O(^TMP($J,NL1,NDT,DA(1))) Q:DA(1)'>0 D DLN Q:NURQUIT
|
|
Q
|
|
DLN I ($Y>(IOSL-6)!('NURSW1)) D HEADER Q:NURQUIT
|
|
S NDATA=^NURSA(214.6,DA(1),0),Y=NDT D:+Y D^DIQ W !,Y,?26,$P(NDATA,"^",3)
|
|
;F X=1:1:$L($P(NDATA,"^",4)) W ?(31+((X-1)*2)),$E($P(NDATA,"^",4),X)
|
|
W ?31,$P(NDATA,U,4)
|
|
W ?45,$S($P(NDATA,"^",9)="":"",'$D(^NURSF(213.3,$P(NDATA,"^",9),1)):"",1:$P(^(1),"^",1))
|
|
W ?55,$E($P(NDATA,"^",7),1,25) I $L($P(NDATA,"^",7))>25 W !,?55,$E($P(NDATA,"^",7),26,50)
|
|
Q
|
|
HEADER ; HEADINGS
|
|
I $E(IOST)="C",NURSW1 D ENDPG^NURSUT1 S:NUROUT NURQUIT=+NUROUT Q:NURQUIT
|
|
S NURPAGE=NURPAGE+1,Y=DT D:+Y D^DIQ W:$E(IOST)="C"!(NURPAGE>1) @IOF
|
|
W !!,Y W:NURSSEL ?17 W:'NURSSEL ?20 W "INDIVIDUAL PATIENT CLASSIFICATION REPORT",$S(NURSSEL:" BY WARD",1:""),?71,"PAGE: ",NURPAGE
|
|
W !,$$REPEAT^XLFSTR("-",80)
|
|
S NURSW1=1,NADMT=$S($P(VAIN(7),"^",2)'="":$P(VAIN(7),"^",2),1:"")
|
|
S NPWARD=$S($D(^NURSF(214,DFN,0)):+$P(^(0),"^",3),1:"") D EN6^NURSAUTL
|
|
W !,"PATIENT NAME : ",$E(N1,1,20),?57,"SSN: ",SSN,!,"ADMISSION DATE: ",NADMT,?57,"WARD: ",NPWARD
|
|
W !,?45,"BED"
|
|
W !,?5,"DATE/TIME",?25,"NO.",?31,"FACTORS",?45,"SECT",?55,"COMMENTS"
|
|
W !,?5,"---------",?25,"---",?31,"-------",?45,"----",?55,"--------"
|
|
W !!,?5,"CLASSIFICATION WARD: ",$S(NL1'=" BLANK":NL1,1:""),!
|
|
Q
|