| 1 | YSMV1 ;SLC/DKG,SLC/TGA-MOVE CN,MSG CONTINUED ;11/16/90 08:51 ;
|
|---|
| 2 | ;;5.01;MENTAL HEALTH;;Dec 30, 1994
|
|---|
| 3 | ;
|
|---|
| 4 | DTS ; Called by routine YSMV
|
|---|
| 5 | S (YSIDT,K)=0 W !!?10,"PREVIOUS ",YSTL,"(S)",!
|
|---|
| 6 | NIDT ;
|
|---|
| 7 | F S YSIDT=$O(^PTX(YSDFN,YSTY,YSIDT)) Q:'YSIDT S YSUSR=0 D
|
|---|
| 8 | .F S YSUSR=$O(^PTX(YSDFN,YSTY,YSIDT,1,YSUSR)) Q:'YSUSR S YSCD=0 D
|
|---|
| 9 | ..F S YSCD=$O(^PTX(YSDFN,YSTY,YSIDT,1,YSUSR,1,YSCD)) Q:'YSCD D
|
|---|
| 10 | ...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.
|
|---|
| 11 | ...W !?8,$J(K,3)," ",YSDT(1)_" at "_YSTM
|
|---|
| 12 | SEL ;
|
|---|
| 13 | 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
|
|---|
| 14 | 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
|
|---|
| 15 | 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
|
|---|
| 16 | SEL1 ;
|
|---|
| 17 | 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
|
|---|
| 18 | SET ;
|
|---|
| 19 | 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
|
|---|
| 20 | ;
|
|---|
| 21 | CLG ; Called by routine YSMV
|
|---|
| 22 | I $G(YSKTY) K ^PTX(YSDFN,YSTY),YSKTY Q
|
|---|
| 23 | Q:'$D(^PTX(YSDFN,YSTY))
|
|---|
| 24 | S (YSHCD,YSCDT,YSHUS,YSUST)=0
|
|---|
| 25 | HCD ;
|
|---|
| 26 | F S YSHCD=$O(^PTX(YSDFN,YSTY,YSIDT,1,YSUSR,1,YSHCD)) Q:'YSHCD S YSCDT=YSCDT+1
|
|---|
| 27 | I YSCDT>1 K YSHCD,YSCDT,YSHUS,YSUST,^PTX(YSDFN,YSTY,YSIDT,1,YSUSR,1,YSCD) Q
|
|---|
| 28 | K YSHCD,YSCDT F S YSHUS=$O(^PTX(YSDFN,YSTY,YSIDT,1,YSHUS)) Q:'YSHUS S YSUST=YSUST+1
|
|---|
| 29 | I YSUST>1 K YSHUS,YSUST,^PTX(YSDFN,YSTY,YSIDT,1,YSUSR) Q
|
|---|
| 30 | ;
|
|---|
| 31 | SETV ; Called by routine YSMV
|
|---|
| 32 | ; Move of Crisis Notes/Messages into Progress Note File (^GMR(121)).
|
|---|
| 33 | S YSNOTE=$S("CN"[YSTY:"CRISIS NOTE","MS"[YSTY:"MESSAGE",1:"") Q:YSNOTE="" S YSNTE=1 W !!?18,"Moving ",YSNOTE," now.",!
|
|---|
| 34 | 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
|
|---|
| 35 | 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
|
|---|
| 36 | S DR="200///NOW",DR(2,121.05)=".01///NOW;.02////"_DUZ_";.03////"_$S("CN"[YSTY:22,1:1)_";.04////"_DUZ D ^DIE
|
|---|
| 37 | S %X="^PTX(YSDFN,YSTY,YSIDT,1,YSUSR,1,YSCD,1,",%Y="^GMR(121,DA,10," D %XY^%RCR
|
|---|
| 38 | W !!?18,"*** MOVE COMPLETED ***",! K YSHUS,YSUST,YSDTPN,YSNTE,YSNOTE K ^PTX(YSDFN,YSTY,YSIDT,1,YSUSR,1,YSCD)
|
|---|
| 39 | ;
|
|---|
| 40 | FCK ; Called by routine YSPTX
|
|---|
| 41 | ; Attempts to clear file entries for patient (^PTX).
|
|---|
| 42 | I '$O(^PTX(YSDFN,YSTY,YSIDT,1,YSUSR,1,0)) K ^PTX(YSDFN,YSTY,YSIDT)
|
|---|
| 43 | I '$O(^PTX(YSDFN,YSTY,0)) K ^PTX(YSDFN,YSTY)
|
|---|
| 44 | I $O(^PTX(YSDFN,0))="" S DIK="^PTX(",DA=YSDFN D ^DIK
|
|---|
| 45 | Q
|
|---|
