source: WorldVistAEHR/trunk/r/MENTAL_HEALTH-YS-RUCL-YI-YT/YSPTX.m@ 1800

Last change on this file since 1800 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.9 KB
Line 
1YSPTX ;SLC/DKG,SLC/TGA-ENTER MSGS & NOTES IN PT. TEXT FILE ;5/30/91 09:35 ;
2 ;;5.01;MENTAL HEALTH;;Dec 30, 1994
31 ;
4 S YSTL="" W @IOF S YSYDT=DT W !!?3,YSFHDR,"s for ",YSNM," ",YSSEX," age ",YSAGE,!!
5FN ; Called by routine YSPTX1, YSPTXR
6 D DTS G END:YSTOUT!YSUOUT,AD^YSPTXR:YSOP="+"
7EL ;
8 W !!?3,"(E)nter" W:'YSNH "/Edit, (P)rint," R " or (Q)uit: Q// ",A1:DTIME S YSTOUT='$T,YSUOUT=A1["^"
9 G:YSTOUT!YSUOUT END1 S A1=$TR($E(A1),"eqp","EQP") G END:"Q"[A1,ENT^YSPTX1:"E"[A1,^YSPTXR:"P"[A1 W $C(7)," ?" D QUES1^YSPTX1 G EL
10 ;
11DTS ;
12 S (YSNH,YSOP)=0 I '$D(^PTX(YSDFN,YSTY)) S YSNH=1 W $C(7),!!?3,"No ",YSFHDR,"s on file",!! Q
13 K A S (K,YSOLD,YSOL,YSPRM,YSPM,YSIDT)=0 W !!?10,"Previous ",YSFHDR,"(s)",!
14IDT ;
15 S YSIDT=$O(^PTX(YSDFN,YSTY,YSIDT)) G:'YSIDT SEL S K=K+1,YSHD=9999999-YSIDT,(Y,A(K))=YSHD
16 D ENDD^YSUTL S (YSOL,YSPM)=0 D:YSTY(0) CK W !?8,$J(K,3)," ",Y G IDT
17SEL ;
18 I YSPRM!YSOLD W !!?8,"* Patient Messages/Crisis Notes may be moved to ",!?10,"Progress Notes through the MHS Manager Option.",!
19 I K=1 W !!?10,Y R " OK? Y// ",A1:DTIME S YSTOUT='$T,YSUOUT=A1["^" Q:YSTOUT!YSUOUT S A1=$TR($E(A1),"yn","YN") I "Y"[A1 S YSYDT=A(1) Q
20 I K=1 Q:A1="N" W:A1'["?" " ?",$C(7) D QUES2^YSPTX1 G DTS
21SL1 ;
22 W !!?3,"Select ",YSFHDR," NUMBER (Type '+' only to list more than one): " R YSOP:DTIME S YSTOUT='$T,YSUOUT=YSOP["^" Q:YSTOUT!YSUOUT!("+"[YSOP) I $D(A(YSOP)) S YSYDT=A(YSOP) Q
23 W:YSOP'["?" $C(7)," ?" D QUES3^YSPTX1 G SL1
24 ;
25NN ; Called by routine YSPTX1
26 I '$D(^PTX(YSDFN,YSTY,YSIDT,1,DUZ,1,0)) S A2=1 Q
27 K K S (K,A2)=0 W !!?10,YSFHDR," TIME(S):",!
28A2 ;
29 S A2=$O(^PTX(YSDFN,YSTY,YSIDT,1,DUZ,1,A2)) G:'A2 SA2 S K=K+1,K(K)=A2,YSDTM=^(A2,0)
30 S Y=$P(YSDTM,"."),YSYD=$P(YSDTM,".",2) D ENDD^YSUTL
31 S YSMN=$E(YSYD,3,4) S:$L(YSMN)=1 YSMN=YSMN_"0"
32 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=12&(YSMN>0):"P",YSHR>12:"P",1:0),YSTM=A_":"_YSMN_" "_M_"M"
33 W !?8,$J(K,3)," ",YSDT(1)_" at "_YSTM G A2
34SA2 ;
35 I K=1 R " OK? Y// ",A1:DTIME S YSTOUT='$T,YSUOUT=A1["^" Q:YSTOUT!YSUOUT S A1=$TR($E(A1),"yn","YN") S:A1="" A1="Y" G:A1="N" AT I "Y"[A1 S A2=K(K) Q
36 I K=1 W:A1'["?" " ?",$C(7) D QUES2^YSPTX1 G NN
37SC1 ;
38 W !!?3,"Select ",YSFHDR," NUMBER: " R A4:DTIME S YSTOUT='$T,YSUOUT=A4["^" Q:YSTOUT!YSUOUT G:A4="" AT S:$D(K(A4)) A2=K(A4) I A4<1!(A4>K) W:A4'["?" " ?",$C(7) D QUES3^YSPTX1 G SC1
39 Q:A4>0&(A4'>K)
40AT ;
41 W !!?3,"Are you adding a NEW ",YSFHDR R " for this patient? Y// ",A1:DTIME S YSTOUT='$T,YSUOUT=A1["^" Q:YSTOUT!YSUOUT S A1=$TR($E(A1),"yn","YN") I "Y"[A1 S:YSYDT=DT A2=K(K)+1 S:YSYDT'=DT A2=1,YSYDT=DT,YSIDT=9999999-YSYDT Q
42 Q:"N"[A1 W " ?",$C(7) D QUES4^YSPTX1 G AT
43 ;
44CN ; Called from MENU option YSCRISNOT
45 ;
46 S YSTL="" D ^YSLRP G:YSDFN<1 END1 S YSTY="CN",YSTY(0)=1,YSFN1="^99.29D^",YSFN2="^99.3P^",YSFN3="^99.31^",YSFHDR="Crisis Note"
47 G 1
48PN ;
49 D ^YSLRP G:YSDFN<1 END S YSTY="PN",YSTY(0)=0,YSFN1="^99.01D^",YSFN2="^99.02P^",YSFN3="^99.03^",YSFHDR="Progress Note",YSFTR="SF 509"
50 G 1
51 ;
52MS ; Called from MENU option YSPATMSG
53 ;
54 S YSTL="" D ^YSLRP G:YSDFN<1 END1 S YSTY="MS",YSTY(0)=1,YSFN1="^99.39D^",YSFN2="^99.4P^",YSFN3="^99.41^",YSFHDR="Message"
55 G 1
56 ;
57END ; Called by routine YSPTX1
58 I '$G(YSIDT) S YSIDT=9999999-DT
59 S YSUSR=DUZ D FCK^YSMV1
60END1 ; Called by routine YSPTXR
61 I $G(YSTOUT),IOST?1"C-".E W:IOF]"" @IOF
62 K %,%DT,%ZIS,A,A1,A2,A3,A4,B4,C,D,DIC,DIW,DIWF,DIWL,DIWR,DIWT,DN,DW2,DWI,I,I0,IO("Q"),J,K,L,M,X,X1,Y,YSCON,YSD,YSDC,YSDH,YSDTM,YSFN1,YSFN2,YSFN3,YSFTR,YSHD,YSFHDR
63 K YSHR,YSLDT,YSMOR,YSMN,YSNH,YSNN,YSNS,YSNT,YSNU,YSOL,YSOLD,YSOP,YSP4,YSPF,YSP0,YSPM,YSPRM,YSPTD,YSSP,YSTHN,YSTM,YSTN,YSTXN,YSUR,YSUS,YSUSER,YSUSN,YSUSR,YSUTL,YSYN
64 K YSYD,YSYDT,Z,ZTSK K:YSTL="" YSAGE,YSDOB,YSSEX,YSSSN K YSTL Q
65CK ;
66 S YSUSR=0
67USR ;
68 S YSUSR=$O(^PTX(YSDFN,YSTY,YSIDT,1,YSUSR)) Q:'YSUSR S YSTXN=0
69TXN ;
70 S YSTXN=$O(^PTX(YSDFN,YSTY,YSIDT,1,YSUSR,1,YSTXN)) G:'YSTXN USR I $D(^PTX(YSDFN,YSTY,YSIDT,1,YSUSR,1,YSTXN,2)),^(2)="P" S:YSOL YSOL=0 S YSPM=1 S YSPRM=1 Q
71OLD ;
72 S:'YSPM YSOL=1 S YSOLD=1
73 G TXN
Note: See TracBrowser for help on using the repository browser.