source: FOIAVistA/trunk/r/MENTAL_HEALTH-YS-RUCL-YI-YT/YSMV1.m@ 1379

YSMV1 ;SLC/DKG,SLC/TGA-MOVE CN,MSG CONTINUED ;11/16/90  08:51 ;
 ;;5.01;MENTAL HEALTH;;Dec 30, 1994
 ;
DTS ;  Called by routine YSMV
 S (YSIDT,K)=0 W !!?10,"PREVIOUS ",YSTL,"(S)",!
NIDT ;
 F  S YSIDT=$O(^PTX(YSDFN,YSTY,YSIDT)) Q:'YSIDT  S YSUSR=0 D
 .F  S YSUSR=$O(^PTX(YSDFN,YSTY,YSIDT,1,YSUSR)) Q:'YSUSR  S YSCD=0 D
 ..F  S YSCD=$O(^PTX(YSDFN,YSTY,YSIDT,1,YSUSR,1,YSCD)) Q:'YSCD  D
 ...S K=K+1,YSA(K)=YSTY_U_YSIDT_U_YSUSR_U_YSCD,YSDTM=^(YSCD,0),Y=$P(YSDTM,"."),YSHM=$P(YSDTM,".",2) D ENDD^YSUTL,ENHM^YSUTL ; The naked reference to ^(YSCD,0) was defined in the FOR loop on the previous line.
 ...W !?8,$J(K,3),"  ",YSDT(1)_" at "_YSTM
SEL ;
 I K=1 W ! R "    OK? N// ",A:DTIME S YSTOUT='$T,YSUOUT=A["^" S YSQT=YSTOUT I $S(YSTOUT:1,"Nn^"[A:1,1:0) K YSTY Q
 Q:K<1  G:K>1 SEL1 I "Yy"'[A W !?5,"  Please enter ""Y"" or ""N"". ""Y"" will move the note, ""N"" will leave it alone",$C(7) G SEL
 S YSKTY=1,YSTY=$P(YSA(1),U),YSIDT=$P(YSA(1),U,2),YSUSR=$P(YSA(1),U,3),YSCD=$P(YSA(1),U,4) Q
SEL1 ;
 W !!?3,"Select ",YSTL," NUMBER: " R A:DTIME S YSTOUT='$T,YSUOUT=A["^" G:YSTOUT!YSUOUT!(A="") FIN^YSMV G:A>0&(A'>K) SET I A<1!(A>(K)) W $C(7),!!?3,"NUMBER OUT OF RANGE!! ",! G SEL1
SET ;
 S YSTY=$P(YSA(A),U),YSIDT=$P(YSA(A),U,2),YSUSR=$P(YSA(A),U,3),YSCD=$P(YSA(A),U,4) Q
 ;
CLG ; Called by routine YSMV
 I $G(YSKTY) K ^PTX(YSDFN,YSTY),YSKTY Q
 Q:'$D(^PTX(YSDFN,YSTY))
 S (YSHCD,YSCDT,YSHUS,YSUST)=0
HCD ;
 F  S YSHCD=$O(^PTX(YSDFN,YSTY,YSIDT,1,YSUSR,1,YSHCD)) Q:'YSHCD  S YSCDT=YSCDT+1
 I YSCDT>1 K YSHCD,YSCDT,YSHUS,YSUST,^PTX(YSDFN,YSTY,YSIDT,1,YSUSR,1,YSCD) Q
 K YSHCD,YSCDT F  S YSHUS=$O(^PTX(YSDFN,YSTY,YSIDT,1,YSHUS)) Q:'YSHUS  S YSUST=YSUST+1
 I YSUST>1 K YSHUS,YSUST,^PTX(YSDFN,YSTY,YSIDT,1,YSUSR) Q
 ;
SETV ; Called by routine YSMV
 ; Move of Crisis Notes/Messages into Progress Note File (^GMR(121)).
 S YSNOTE=$S("CN"[YSTY:"CRISIS NOTE","MS"[YSTY:"MESSAGE",1:"") Q:YSNOTE=""  S YSNTE=1 W !!?18,"Moving ",YSNOTE," now.",!
 S YSDTPN=$P(^PTX(YSDFN,YSTY,YSIDT,1,YSUSR,1,YSCD,0),U),DIC="^GMR(121,",DIC(0)="L",DLAYGO=121,X="""N""" D ^DIC Q:Y'>0
 S DA=+Y,DIE=DIC,DR=".02////"_YSDFN_";.03///"_YSDTPN_";.05////"_YSUSR_";.06///^S X=""Y"";1////"_YSNTE_";2////"_YSUSR_";3////"_YSUSR_";4///NOW;4.1////"_DUZ D ^DIE
 S DR="200///NOW",DR(2,121.05)=".01///NOW;.02////"_DUZ_";.03////"_$S("CN"[YSTY:22,1:1)_";.04////"_DUZ D ^DIE
 S %X="^PTX(YSDFN,YSTY,YSIDT,1,YSUSR,1,YSCD,1,",%Y="^GMR(121,DA,10," D %XY^%RCR
 W !!?18,"*** MOVE COMPLETED ***",! K YSHUS,YSUST,YSDTPN,YSNTE,YSNOTE K ^PTX(YSDFN,YSTY,YSIDT,1,YSUSR,1,YSCD)
 ;
FCK ; Called by routine YSPTX
 ; Attempts to clear file entries for patient (^PTX).
 I '$O(^PTX(YSDFN,YSTY,YSIDT,1,YSUSR,1,0)) K ^PTX(YSDFN,YSTY,YSIDT)
 I '$O(^PTX(YSDFN,YSTY,0)) K ^PTX(YSDFN,YSTY)
 I $O(^PTX(YSDFN,0))="" S DIK="^PTX(",DA=YSDFN D ^DIK
 Q