| [613] | 1 | YSCEN33 ;ALB/ASF-NOTE LOOKUP ;12/18/90 18:38 ;
|
|---|
| 2 | ;;5.01;MENTAL HEALTH;;Dec 30, 1994
|
|---|
| 3 | ;
|
|---|
| 4 | PN2 ; 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
|
|---|
| 8 | PNX ;
|
|---|
| 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
|
|---|
| 10 | MOR ;
|
|---|
| 11 | S YSIDT=0
|
|---|
| 12 | NIDT ;
|
|---|
| 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
|
|---|
| 14 | CLN ;
|
|---|
| 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
|
|---|
| 17 | TOP ;
|
|---|
| 18 | S YSH1=YSTLL_" beginning "_YSLDT1_" for "_YSNM_" "_YSSSN Q
|
|---|
| 19 | TOP1 ;
|
|---|
| 20 | W @IOF W:IOST?1"C-".E !! W YSH1," cont.",! Q
|
|---|
| 21 | TOP2 ;
|
|---|
| 22 | D WAIT^YSCEN1 Q:Q3 D TOP1 Q
|
|---|
| 23 | CP ;
|
|---|
| 24 | K YSUSN D FU^YSPTXR
|
|---|
| 25 | CP1 ;
|
|---|
| 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 !
|
|---|
| 31 | DT ;
|
|---|
| 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
|
|---|
| 38 | DIWP ;
|
|---|
| 39 | S Z=DIC_"0)",DW2=$P(@(Z),U,4) W !! X DWI Q:Q3 D ^DIWW Q
|
|---|
| 40 | UNM ;
|
|---|
| 41 | D:$Y+YSPF>IOSL TOP2 Q:Q3 S X=YSUSER D PSIG^YSUTL W !?3,Y Q
|
|---|
| 42 | DRG ;
|
|---|
| 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
|
|---|
| 45 | DRG1 ;
|
|---|
| 46 | S DA=^UTILITY($J,YSNM,YSDFN),L=^YSG("INP",DA,0) D P4^YSCEN52 Q
|
|---|
