source: WorldVistAEHR/trunk/r/MENTAL_HEALTH-YS-RUCL-YI-YT/YSCEN33.m@ 703

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

initial load of WorldVistAEHR

File size: 2.1 KB
Line 
1YSCEN33 ;ALB/ASF-NOTE LOOKUP ;12/18/90 18:38 ;
2 ;;5.01;MENTAL HEALTH;;Dec 30, 1994
3 ;
4PN2 ; Called by routine YSCEN3
5 ;
6 S Y=9999999-YSLDT D DD^%DT S YSLDT1=Y
7 S YSPF=$S(IOST["C-":5,1:10) D ENPT^YSUTL,TOP W @IOF,!?3,"Ward: ",W2," Team: ",$S(T6?1N.N:$P(^YSG("SUB",T6,0),U),1:"Unassigned"),!,YSH1
8PNX ;
9 S YSG=$O(^PTX(YSDFN,YSTY,0)) I 'YSG!(YSG>YSLDT) W !!?10,"*** NO ",$S(YSTY="CN":"Crisis Note",YSTY="MS":"Message",YSTY="PN":"Progress note",1:""),"s on file" W:YSG>1 " for this period ***" D:YSTY'="CN" WAIT^YSCEN1 G CLN
10MOR ;
11 S YSIDT=0
12NIDT ;
13 S YSFIN=0,YSCEN3F=0 S:'$D(YSLDT) YSLDT=9999999 S YSIDT=$O(^PTX(YSDFN,YSTY,YSIDT)) G:'YSIDT!(YSIDT>YSLDT) CLN S YSYDT=9999999-YSIDT S:IOST["P-" YSCEN3F=1 D CP G:Q3 CLN G NIDT
14CLN ;
15 I YSTY="CN" S YSTY="MS" G PNX
16 S:YSTY="MS" YSTY="CN" K IOP,N4,YSAGE,B1,YSDOB,YSNM,YSSEX,YSSSN,YSBID,YSTM,YSUS,YSUSER,YSUSN D KVAR^VADPT Q
17TOP ;
18 S YSH1=YSTLL_" beginning "_YSLDT1_" for "_YSNM_" "_YSSSN Q
19TOP1 ;
20 W @IOF W:IOST?1"C-".E !! W YSH1," cont.",! Q
21TOP2 ;
22 D WAIT^YSCEN1 Q:Q3 D TOP1 Q
23CP ;
24 K YSUSN D FU^YSPTXR
25CP1 ;
26 S YSUS=$O(YSUSN(YSUS)) Q:'YSUS
27 S YSUSER=$P(YSUSN(YSUS),U) S YSNT=$P(YSUSN(YSUS),U,3)
28 S DIC="^PTX(YSDFN,YSTY,YSIDT,1,YSUSER,1,YSNT,1,"
29 S DIWL=7,DIWR=75,DIWF="W",DWI="F D=1:1:DW2 S X="_DIC_"D,0) D:$Y+YSPF>IOSL TOP2 Q:Q3 D ^DIWP"
30 D:$Y+YSPF>IOSL TOP2 Q:Q3 U IO W !
31DT ;
32 S YSDTM=$P(YSUSN(YSUS),U,2),Y=$P(YSDTM,".") D ENDD^YSUTL S YSYD=$P(YSDTM,".",2),YSMN=$E(YSYD,3,4) S:$L(YSMN)=1 YSMN=YSMN_"0"
33 S YSHR=$E(YSYD,1,2),A=$S(YSHR<12:YSHR,YSHR>12:YSHR-12,YSHR=12:12,1:"00"),M=$S(YSHR<12:"A",YSHR>11:"P",1:0),YSTM=A_":"_YSMN_" "_M_"M"
34 D:$Y+YSPF+3>IOSL TOP2 Q:Q3 W !?3,YSDT(1)," at ",YSTM
35 W ?30,$S(YSTY="PN":"Progress Note:",YSTY="CN":"Crisis Note:",YSTY="MS":"Message:",1:"")
36 I $D(^PTX(YSDFN,YSTY,YSIDT,1,YSUSER,1,YSNT,2)),^(2)="P" W " (Permanent)"
37 D DIWP Q:Q3 D UNM Q:Q3 G CP1
38DIWP ;
39 S Z=DIC_"0)",DW2=$P(@(Z),U,4) W !! X DWI Q:Q3 D ^DIWW Q
40UNM ;
41 D:$Y+YSPF>IOSL TOP2 Q:Q3 S X=YSUSER D PSIG^YSUTL W !?3,Y Q
42DRG ;
43 S (P1,YSNM)=0,YSN1="X" F S YSNM=$O(^UTILITY($J,YSNM)) Q:YSNM="" S YSDFN=0 F S YSDFN=$O(^UTILITY($J,YSNM,YSDFN)) Q:'YSDFN S DFN=YSDFN D DRG1
44 Q
45DRG1 ;
46 S DA=^UTILITY($J,YSNM,YSDFN),L=^YSG("INP",DA,0) D P4^YSCEN52 Q
Note: See TracBrowser for help on using the repository browser.