source: FOIAVistA/trunk/r/MENTAL_HEALTH-YS-RUCL-YI-YT/YSPHY1.m@ 1607

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

initial load of FOIAVistA 6/30/08 version

File size: 3.2 KB
Line 
1YSPHY1 ;SLC/DJP-CONTINUATION OF YSPHY ;11/15/90 16:34 ;
2 ;;5.01;MENTAL HEALTH;;Dec 30, 1994
3 ;
4ENCLN ; Called by routine YSPHY
5 I $P(^MR(YSDFN,"PE",YSIDT,0),U)'=DT D:YSEDIT=1 MSG5 D:YSEDIT=0 MSG6 Q
6CLNCK ;
7 I $D(^MR(YSDFN,"PE",YSIDT,.8)) D:YSEDIT=1 MSG3 D:YSEDIT=0 MSG6 Q
8PCSET ;
9 I YSNEW=1 S YSPNUM=$P(^MR(YSDFN,"PE",0),U,4) S $P(^MR(YSDFN,"PE",0),U,4)=YSPNUM-1 K YSPNUM
10PHYCLN ;
11 K ^MR(YSDFN,"PE",YSIDT),^MR(YSDFN,"PE","B",YSYDT) D MSG4
12 I YSNP=1 K ^MR("B",YSDFN,YSDFN),^MR(YSDFN),^MR(YSDFN,"PE",0)
13 Q
14YSDIZ ; Called by routine YSPHY
15 S DP=90.01
16 S YSZS=^MR(YSDFN,YSPE,YSIDT,.9) F I=1:1:19 S YSZS(I+1)=$P(YSZS,U,I)
17 S YSZS="" F Z=2:1:11,$S(YSSEX["F":13,1:12),14:1:19 D DIZ1 Q:X["^"
18 S YSZS="" F I=2:1:19 S YSZS=YSZS_YSZS(I)_U
19 L +^MR(YSDFN) S ^MR(YSDFN,YSPE,DA,.9)=YSZS L -^MR(YSDFN)
20 Q
21DIZ1 ;
22 S DP=90.01,DQ=^DD(DP,Z,0),YSDE=YSZS(Z) D ^YSDIZ Q:X["^" S YSZS(Z)=YSDE D ABNORM:YSDE>2 Q
23ABNORM ;
24 S DIE=YSDIZ,DR=$S(X=3:Z_".9",1:Z_".1:"_Z_".9") D ^DIE Q
25HLP1 ; Called by routine YSPHY
26 I YSNEW=0 W !!,"Enter 'E' to EDIT an existing physical for this patient.",!!,"Enter 'P' to PRINT a current physical for this patient."
27 I YSNEW=1 W !!,"Enter 'E' to ENTER a new physical for this patient."
28 W !!,"Enter 'Q' to QUIT the exam process."
29 Q
30HLP2 ; Called by routine YSPHY
31 W !!!,"Entering 'Y' or <CR> for 'YES' accepts the given PREVIOUS exam for EDITING",!?5,"or PRINTING."
32 W !!,"ENTERING 'N' for 'NO' allows you to ENTER a new exam." D HLP3
33 Q
34HLP3 ;
35 W !!,$C(7,7),"IMPORTANT NOTE: (1). You may NOT enter MORE than ONE EXAM per PATIENT per DAY."
36 W !?16,"(2). Only the DESIGNATED EXAMINER can EDIT a PREVIOUS exam.",!!
37 Q
38HLP4 ; Called by routine YSPHY
39 W !!,"Enter a previous physical exam NUMBER to EDIT an existing exam."
40 W !!,"Or enter <CR> to CREATE a NEW physical exam." D HLP3
41 Q
42CHK1 ; Called by routine YSPHY
43 Q:YSNEW=1 S YSEDUZ=$P(^MR(YSDFN,YSPE,YSLDT,0),U,10) I YSEDUZ'=DUZ S YSUOUT=1 D MSG1 Q
44 Q
45CHK2 ; Called by routine YSPHY
46 I YSYDT=YSA(1) D MSG2 S YSUOUT=1 Q
47 ;Using A(1) instead of A(K) will force compare to the most current exam.
48 S YSNEW=1
49 Q
50MSG1 ;
51 W !!,$C(7),?1,"*** ONLY THE DESIGNATED EXAMINER MAY EDIT A PREVIOUSLY ENTERED EXAM ***",!! H 3
52 Q
53MSG2 ;
54 W !!,$C(7),?1,"** A PREVIOUS physical EXAM for this PATIENT was created TODAY **"
55 W !?1,"** You may NOT create MORE than ONE physical EXAM per PATIENT per DAY **",!! H 3
56 Q
57MSG3 ; Called by routine YSPHY
58 W !!?1,"** The EXAM SAVED with the remaining portion SET to NORMAL **" H 3
59 Q
60MSG4 ;
61 W !!,$C(7),?10,"** PROCESSING OF THIS EXAM WAS TERMINATED **"
62 W !!?10,"** << EXAM DELETED FROM FILES >> **" H 3
63 Q
64MSG5 ;
65 W !!,$C(7),?10,"** << EXAM SAVED >> **",! H 3
66 Q
67MSG6 ; Called by routine YSPHY
68 W !!?1,"** The EXAM SAVED with remaining portion set as previously entered **",! H 3
69 Q
70END ; Called by routine YSPHY, YSPHYR
71 I $D(YSTOUT),YSTOUT W:IOF]"" @IOF
72 F J=1:1:18 S X="V"_J K @X
73 K %,%DT,%ZIS,A,A1,B4,C,D,J,K,D0,DA,DIC,DIE,DP,DQ,DR,YSDT(0),YSDT(1),DXS,I,I0,IO("Q"),IOP,J,K,L,M,P,POP,X,X1,Y,YS,YSAGE,YSAC,YSBL,YSBLN,YSCD,YSCON,YSDE,YSDFN,YSDH,YSDIZ,YSDOB,YSDOT,YSDTM,YSFTR,YSHD,YSFHDR,YSIDT
74 K YSLFT,YSNM,YSNP,YSNS,YSPE,YSPI,YSPPL,YSPST,YSPSV,YSPY,YSSEX,YSSP,YSSSN,YST,YSTM,YSTOUT,YSUOUT,YSUSER,YSX,YSYDT,YSYN,YSZS,YSZZ,Z,ZTSK I $D(YSTIME) S:YSTIME>0 DTIME=YSTIME
75 K YSTIME,YSLDT,YSNEW,YSEDIT,YSEDUZ Q
Note: See TracBrowser for help on using the repository browser.