source: WorldVistAEHR/trunk/r/MENTAL_HEALTH-YS-RUCL-YI-YT/YSMV.m@ 634

YSMV ;SLC/DKG,SLC/TGA-MOVE CNs & MSGs TO PROGRESS NOTES ;4/20/92  09:26 ;
 ;;5.01;MENTAL HEALTH;;Dec 30, 1994
 ;
 ; Called from the top by MENU option YSMOVP
 ;
 N C,DFN,K,VA,VADM,VAERR,Y,YSAGE,YSCD,YSDFN,YSDOB,YSDTM,YSHM,YSHR,YSIDT,YSMN,YSNM,YSQT,YSSEX,YSSSN,YSTL,YSTM,YSTY,YSUSR,YSYF,YSFD
 D ^YSLRP Q:YSDFN<1  I '$G(YSDT(0)) D ENDTM^YSUTL
 I '$O(^PTX(YSDFN,"CN",0))&'$O(^PTX(YSDFN,"MS",0)) W $C(7),!!?3,"NO CRISIS NOTES OR MESSAGES ON FILE FOR ",YSNM Q
 W @IOF,!!?3,"MOVE CRISIS NOTE OR MESSAGE FOR ",YSNM,"  ",YSSEX,"  AGE ",YSAGE,!
TY ;
 W !!?3,"(C)RISIS NOTE or (M)ESSAGE?  (C or M): " R A:DTIME S YSTOUT='$T,YSUOUT=A["^" Q:YSTOUT!YSUOUT!(A']"")  S A=$TR(A,"cm","CM") I A["?" D  G TY
 .W !!,"Enter either ""C"" to move Crisis notes or ""M"" to move Messages."
 I "CM"'[A W $C(7),"  ?? " G TY
 S YSTL=$S("C"[A:"CRISIS NOTE","M"[A:"MESSAGE",1:""),YSTY=$S("C"[A:"CN","M"[A:"MS",1:"")
 I '$O(^PTX(YSDFN,YSTY,0)) W $C(7),!!?3,"NO ",YSTL," ON FILE FOR ",YSNM K YSTY,YSTL G TY
 D DTS^YSMV1 Q:$G(YSQT)  G:'$D(YSTY) TY
TY1 ;
 I YSTY="CN" R !!?3,"Move to (P)ROGRESS NOTES or (M)ESSAGES?  (P or M) ",YSTTY:DTIME S YSTOUT='$T,YSUOUT=YSTTY["^" Q:YSTOUT!YSUOUT  I YSTTY'?1A!("PpMm"'[YSTTY) W " ??",$C(7) G TY1
 I YSTY'="CN" S YSTTY="P"
 S %X="^PTX(YSDFN,YSTY,YSIDT,1,YSUSR,1,YSCD,",YSTCD=1 S YSTTY=$S('$D(YSTTY):"PN","Pp"[YSTTY:"PN",1:"MS")
 S YSPM=$D(^PTX(YSDFN,YSTY,YSIDT,1,YSUSR,1,YSCD,2))
 S YSYFD=$S(YSTTY="PN":99,1:99.38) F I=.01:.01:.03 S YSYFD(I)=YSYFD+I
 I YSTTY["PN" D SETV^YSMV1 D FIN Q
ACD ;
 I $D(^PTX(YSDFN,YSTTY,YSIDT,1,YSUSR,1,YSTCD)) S YSTCD=YSTCD+1 G ACD
 S %Y="^PTX(YSDFN,YSTTY,YSIDT,1,YSUSR,1,YSTCD," D %XY^%RCR
 I YSPM K ^PTX(YSDFN,YSTTY,YSIDT,1,YSUSR,1,YSTCD,2)
 L +^PTX(YSDFN) I '$D(^PTX(YSDFN,0)) S ^(0)=YSDFN
 I '$D(^PTX(YSDFN,YSTTY,0)) S ^(0)="^"_YSYFD(.01)_"D^"_YSIDT_U_1
 E  S ^PTX(YSDFN,YSTTY,0)=$P(^(0),U,1,3)_U_($P(^(0),U,4)+1)
 I '$D(^PTX(YSDFN,YSTTY,YSIDT,0)) S ^(0)=9999999-YSIDT
 I '$D(^PTX(YSDFN,YSTTY,YSIDT,1,0)) S ^(0)="^"+YSYFD(.02)_"P^"_YSUSR_U_1
 E  S ^PTX(YSDFN,YSTTY,YSIDT,1,0)="^"_YSYFD(.02)_"^"_$S(YSUSR>$P(^(0),U,3):YSUSR,1:$P(^(0),U,3))_U_($P(^(0),U,4)+1)
 S:'$D(^PTX(YSDFN,YSTTY,YSIDT,1,YSUSR,0)) ^(0)=YSUSR
 I '$D(^PTX(YSDFN,YSTTY,YSIDT,1,YSUSR,1,0)) S ^(0)="^"_YSYFD(.03)_"^1^1"
 E  S ^PTX(YSDFN,YSTTY,YSIDT,1,YSUSR,1,0)=$P(^(0),U,1,2)_U_($P(^(0),U,3)+1)_U_($P(^(0),U,4)+1)
 L -^PTX(YSDFN)
AL ;
 S YSLN=$P(^PTX(YSDFN,YSTTY,YSIDT,1,YSUSR,1,YSTCD,1,0),U,4)+1,YSTLN=YSLN+2,^PTX(YSDFN,YSTTY,YSIDT,1,YSUSR,1,YSTCD,1,YSLN,0)=" ",YSLN=YSLN+1
 K YSDT(1),YSDTM,YSHM,YSTM,Y D ENDTM^YSUTL
 S YSYF="" S:YSTY="CN"&(YSTTY="MS") YSYF=" to a MESSAGE"
 L +^PTX(YSDFN) S ^PTX(YSDFN,YSTTY,YSIDT,1,YSUSR,1,YSTCD,1,YSLN,0)="Moved from a " S:YSPM ^(0)=^(0)_" " S ^(0)=^(0)_YSTL_YSYF_" on "_YSDT(1)_" at "_YSTM,YSLN=YSLN+1
 W @IOF,!!?3,YSTL," has been moved.  You may add comments!",!! H 1
 S DIC="^PTX(YSDFN,YSTTY,YSIDT,1,YSUSR,1,YSTCD,1,",^PTX(YSDFN,YSTTY,YSIDT,1,YSUSR,1,YSTCD,1,0)="^^"_YSTLN_U_YSTLN_U_9999999-YSIDT_U,DWPK=1 D EN^DIWE
 S YSLN=$P(^PTX(YSDFN,YSTTY,YSIDT,1,YSUSR,1,YSTCD,1,0),U,4)+1,^PTX(YSDFN,YSTTY,YSIDT,1,YSUSR,1,YSTCD,1,YSLN,0)=" ",YSLN=YSLN+1
 S ^PTX(YSDFN,YSTTY,YSIDT,1,YSUSR,1,YSTCD,1,YSLN,0)="Moved (comments) by "_$P(^VA(200,DUZ,0),U)
 S ^PTX(YSDFN,YSTTY,YSIDT,1,YSUSR,1,YSTCD,1,0)=$P(^PTX(YSDFN,YSTTY,YSIDT,1,YSUSR,1,YSTCD,1,0),U,1,2)_U_YSLN_U_YSLN_U_$P(^PTX(YSDFN,YSTTY,YSIDT,1,YSUSR,1,YSTCD,1,0),U,5,10) L -^PTX(YSDFN)
 D CLG^YSMV1 K A,YSA,YSCD,DIC,YSDTM,YSHM,YSHR,I,YSIDT,J,K,YSKTY,YSLN,M,YSMN,YSPM,YSTCD,YSTL,YSTLN,YSTM,YSTTY,YSTY,YSUSR,X,Y G TY
 ;
FIN ; Called by routine YSMV1
 K CK,CK1,YSCD,YSTTY,A,YSA,DIC,YSDTM,YSHM,YSHR,I,J,K,YSKTY,YSLN,M,YSMN,YSPM,YSTCD,YSTL,YSTLN,YSTM,YSTY,YSYF,YSUSR,Z,Z1,X,%X,Y,%Y,YSYFD Q