source: WorldVistAEHR/trunk/r/MENTAL_HEALTH-YS-RUCL-YI-YT/YSPTX1.m@ 623

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

initial load of WorldVistAEHR
File size: 2.8 KB
Line 
1YSPTX1 ;SLC/DKG-CONTINUATION OF YSPTX ; 5/23/89 15:19 ;
2 ;;5.01;MENTAL HEALTH;;Dec 30, 1994
3 ;
4ENT ; Called by routine YSPTX
5 S YSIDT=9999999-YSYDT,A1="" D NN^YSPTX G END^YSPTX:YSUOUT!YSTOUT I A2<1 W " ?",$C(7) G FN^YSPTX
6 G:A1]""&("Nn"[A1) FN^YSPTX S %DT="T",X="N" D ^%DT S ^PTX(YSDFN,YSTY,YSIDT,1,DUZ,1,A2,1,0)=Y,DIC="^PTX(YSDFN,YSTY,YSIDT,1,DUZ,1,A2,1,"
7 W !!,YSFHDR,": " K ^UTILITY($J,"W")
8 D ENDTM^YSUTL S DWPK=1 D EN^DIWE
9 S YSPM=0 I YSTY(0),$D(^PTX(YSDFN,YSTY,YSIDT,1,DUZ,1,A2,1,1,0)) S YSPM=1
10 I '$D(^PTX(YSDFN,YSTY,YSIDT,1,DUZ,1,A2,1,1,0)) K ^PTX(YSDFN,YSTY,YSIDT,1,DUZ,1,A2,1,0) G:'$D(^PTX(YSDFN,YSTY,YSIDT,1,DUZ,1,A2)) END^YSPTX D CLN G END^YSPTX
11CG ;
12 L +^PTX(YSDFN) I '$D(^PTX(YSDFN,0)) S ^(0)=YSDFN,^PTX("B",YSDFN,YSDFN)=""
13 S YSTN=$P(^PTX(0),U,4)+1,L=$P(^PTX(0),U,3)
14 S L=$S(YSDFN>L:YSDFN,1:L),^PTX(0)=$P(^PTX(0),U,1,2)_U_L_U_YSTN
15 S:'$D(^PTX(YSDFN,YSTY,YSIDT,0)) ^(0)=YSYDT
16 I $D(^PTX(YSDFN,YSTY,0)) S YSNU=$P(^(0),U,4)+1,^(0)=$P(^(0),U,1,3)_U_YSNU
17 E S ^(0)=YSFN1_YSIDT_"^1"
18 I $D(^PTX(YSDFN,YSTY,YSIDT,1,0)) S YSUR=$P(^(0),U,3),YSUR=$S(DUZ>YSUR:DUZ,1:YSUR),YSNU=$P(^(0),U,4)+1,^(0)=$P(^(0),U,1,2)_U_YSUR_U_YSNU
19 E S ^(0)=YSFN2_DUZ_"^1"
20 S:'$D(^PTX(YSDFN,YSTY,YSIDT,1,DUZ,0)) ^(0)=DUZ
21 I $D(^PTX(YSDFN,YSTY,YSIDT,1,DUZ,1,0)) S YSNN=$P(^(0),U,3)+1,^(0)=$P(^(0),U,1,2)_U_YSNN_U_YSNN
22 E S ^(0)=YSFN3_"1^1"
23 S:'$D(^PTX(YSDFN,YSTY,YSIDT,1,DUZ,1,A2,0)) ^(0)=YSDTM S:YSPM ^(2)="P"
24 K:YSTY="CN" ^YSG("CNT","AA",YSDFN,"CN"),^YSG("CNT",1) I YSTY="MS" S N=0 F S N=$O(^YSG("CNT",YSDFN,"MSU",N)) Q:'N S ^YSG("CNT",YSDFN,"MSU",N,0)="NEW"
25 L -^PTX(YSDFN) G FN^YSPTX
26CLN ;
27 I $P(^PTX(YSDFN,YSTY,0),U,4)=1 K ^PTX(YSDFN) Q
28 I $P(^PTX(YSDFN,YSTY,YSIDT,1,0),U,4)=1 S YSP4=$P(^PTX(YSDFN,YSTY,0),U,4),$P(^PTX(YSDFN,YSTY,0),U,4)=YSP4-1 K ^PTX(YSDFN,YSTY,YSIDT),YSP4 Q
29 I $P(^PTX(YSDFN,YSTY,YSIDT,1,DUZ,1,0),U,4)=1 K ^PTX(YSDFN,YSTY,YSIDT,1,DUZ) G RS0
30 I $P(^PTX(YSDFN,YSTY,YSIDT,1,DUZ,1,0),U,3)=A2 S $P(^PTX(YSDFN,YSTY,YSIDT,1,DUZ,1,0),U,3)=A2-1,$P(^PTX(YSDFN,YSTY,YSIDT,1,DUZ,1,0),U,4)=A2-1 K ^PTX(YSDFN,YSTY,YSIDT,1,DUZ,1,A2) G RS0
31 S YSP4=$P(^PTX(YSDFN,YSTY,YSIDT,1,DUZ,1,0),U,4),$P(^PTX(YSDFN,YSTY,YSIDT,1,DUZ,1,0),U,4)=YSP4-1 K ^PTX(YSDFN,YSTY,YSIDT,1,DUZ,1,A2)
32RS0 ;
33 S YSP4=$P(^PTX(YSDFN,YSTY,0),U,4),$P(^PTX(YSDFN,YSTY,0),U,4)=YSP4-1
34 S YSP4=$P(^PTX(YSDFN,YSTY,YSIDT,1,0),U,4),$P(^PTX(YSDFN,YSTY,YSIDT,1,0),U,4)=YSP4-1
35 S YSP4=$P(^PTX(0),U,4),$P(^PTX(0),U,4)=YSP4-1
36 Q
37 ;The following lines support "help" in Routine ^YSPTX
38QUES1 ; Called by routine YSPTX
39 W !!?3,"Please enter appropriate response indicating action to be taken.",!
40 Q
41 ;
42QUES2 ; Called by routine YSPTX
43 W !!?3,"""Y"" will permit editing of text entered this date.",!?3,"""N"" will permit entry of new text.",!
44 Q
45 ;
46QUES3 ; Called by routine YSPTX
47 W !!?3,"Enter corresponding number of text to be accessed.",!
48 Q
49 ;
50QUES4 ; Called by routine YSPTX
51 W !!?3,"""Y"" will permit entry of new text. ""N"" returns to edit question.",! Q
Note: See TracBrowser for help on using the repository browser.