source: WorldVistAEHR/trunk/r/NURSING_SERVICE-NUR/NURARCR1.m@ 1780

Last change on this file since 1780 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.5 KB
RevLine 
[613]1NURARCR1 ;HIRMFO/MD,FT-CONTINUATION VIEW PRINT OF PATIENT CLASSIFICATION ;8/9/96 11:32
2 ;;4.0;NURSING SERVICE;;Apr 25, 1997
3WRITE S NL1="" F S NL1=$O(^TMP($J,NL1)) Q:NL1="" D HEADER:NURSW1,W1 Q:NURQUIT
4 Q
5W1 S NDT="" F S NDT=$O(^TMP($J,NL1,NDT)) Q:NDT="" D W2 Q:NURQUIT
6 Q
7W2 F DA(1)=0:0 S DA(1)=$O(^TMP($J,NL1,NDT,DA(1))) Q:DA(1)'>0 D DLN Q:NURQUIT
8 Q
9DLN I ($Y>(IOSL-6)!('NURSW1)) D HEADER Q:NURQUIT
10 S NDATA=^NURSA(214.6,DA(1),0),Y=NDT D:+Y D^DIQ W !,Y,?26,$P(NDATA,"^",3)
11 ;F X=1:1:$L($P(NDATA,"^",4)) W ?(31+((X-1)*2)),$E($P(NDATA,"^",4),X)
12 W ?31,$P(NDATA,U,4)
13 W ?45,$S($P(NDATA,"^",9)="":"",'$D(^NURSF(213.3,$P(NDATA,"^",9),1)):"",1:$P(^(1),"^",1))
14 W ?55,$E($P(NDATA,"^",7),1,25) I $L($P(NDATA,"^",7))>25 W !,?55,$E($P(NDATA,"^",7),26,50)
15 Q
16HEADER ; HEADINGS
17 I $E(IOST)="C",NURSW1 D ENDPG^NURSUT1 S:NUROUT NURQUIT=+NUROUT Q:NURQUIT
18 S NURPAGE=NURPAGE+1,Y=DT D:+Y D^DIQ W:$E(IOST)="C"!(NURPAGE>1) @IOF
19 W !!,Y W:NURSSEL ?17 W:'NURSSEL ?20 W "INDIVIDUAL PATIENT CLASSIFICATION REPORT",$S(NURSSEL:" BY WARD",1:""),?71,"PAGE: ",NURPAGE
20 W !,$$REPEAT^XLFSTR("-",80)
21 S NURSW1=1,NADMT=$S($P(VAIN(7),"^",2)'="":$P(VAIN(7),"^",2),1:"")
22 S NPWARD=$S($D(^NURSF(214,DFN,0)):+$P(^(0),"^",3),1:"") D EN6^NURSAUTL
23 W !,"PATIENT NAME : ",$E(N1,1,20),?57,"SSN: ",SSN,!,"ADMISSION DATE: ",NADMT,?57,"WARD: ",NPWARD
24 W !,?45,"BED"
25 W !,?5,"DATE/TIME",?25,"NO.",?31,"FACTORS",?45,"SECT",?55,"COMMENTS"
26 W !,?5,"---------",?25,"---",?31,"-------",?45,"----",?55,"--------"
27 W !!,?5,"CLASSIFICATION WARD: ",$S(NL1'=" BLANK":NL1,1:""),!
28 Q
Note: See TracBrowser for help on using the repository browser.