YSCEN33 ;ALB/ASF-NOTE LOOKUP ;12/18/90  18:38 ;
 ;;5.01;MENTAL HEALTH;;Dec 30, 1994
 ;
PN2 ;  Called by routine YSCEN3
 ;
 S Y=9999999-YSLDT D DD^%DT S YSLDT1=Y
 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
PNX ;
 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
MOR ;
 S YSIDT=0
NIDT ;
 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
CLN ;
 I YSTY="CN" S YSTY="MS" G PNX
 S:YSTY="MS" YSTY="CN" K IOP,N4,YSAGE,B1,YSDOB,YSNM,YSSEX,YSSSN,YSBID,YSTM,YSUS,YSUSER,YSUSN D KVAR^VADPT Q
TOP ;
 S YSH1=YSTLL_" beginning "_YSLDT1_" for "_YSNM_"  "_YSSSN Q
TOP1 ;
 W @IOF W:IOST?1"C-".E !! W YSH1,"  cont.",! Q
TOP2 ;
 D WAIT^YSCEN1 Q:Q3  D TOP1 Q
CP ;
 K YSUSN D FU^YSPTXR
CP1 ;
 S YSUS=$O(YSUSN(YSUS)) Q:'YSUS
 S YSUSER=$P(YSUSN(YSUS),U) S YSNT=$P(YSUSN(YSUS),U,3)
 S DIC="^PTX(YSDFN,YSTY,YSIDT,1,YSUSER,1,YSNT,1,"
 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"
 D:$Y+YSPF>IOSL TOP2 Q:Q3  U IO W !
DT ;
 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"
 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"
 D:$Y+YSPF+3>IOSL TOP2 Q:Q3  W !?3,YSDT(1)," at ",YSTM
 W ?30,$S(YSTY="PN":"Progress Note:",YSTY="CN":"Crisis Note:",YSTY="MS":"Message:",1:"")
 I $D(^PTX(YSDFN,YSTY,YSIDT,1,YSUSER,1,YSNT,2)),^(2)="P" W "   (Permanent)"
 D DIWP Q:Q3  D UNM Q:Q3  G CP1
DIWP ;
 S Z=DIC_"0)",DW2=$P(@(Z),U,4) W !! X DWI Q:Q3  D ^DIWW Q
UNM ;
 D:$Y+YSPF>IOSL TOP2 Q:Q3  S X=YSUSER D PSIG^YSUTL W !?3,Y Q
DRG ;
 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
 Q
DRG1 ;
 S DA=^UTILITY($J,YSNM,YSDFN),L=^YSG("INP",DA,0) D P4^YSCEN52 Q