| [613] | 1 | YSPTX1 ;SLC/DKG-CONTINUATION OF YSPTX ; 5/23/89 15:19 ;
|
|---|
| 2 | ;;5.01;MENTAL HEALTH;;Dec 30, 1994
|
|---|
| 3 | ;
|
|---|
| 4 | ENT ; 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
|
|---|
| 11 | CG ;
|
|---|
| 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
|
|---|
| 26 | CLN ;
|
|---|
| 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)
|
|---|
| 32 | RS0 ;
|
|---|
| 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
|
|---|
| 38 | QUES1 ; Called by routine YSPTX
|
|---|
| 39 | W !!?3,"Please enter appropriate response indicating action to be taken.",!
|
|---|
| 40 | Q
|
|---|
| 41 | ;
|
|---|
| 42 | QUES2 ; 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 | ;
|
|---|
| 46 | QUES3 ; Called by routine YSPTX
|
|---|
| 47 | W !!?3,"Enter corresponding number of text to be accessed.",!
|
|---|
| 48 | Q
|
|---|
| 49 | ;
|
|---|
| 50 | QUES4 ; Called by routine YSPTX
|
|---|
| 51 | W !!?3,"""Y"" will permit entry of new text. ""N"" returns to edit question.",! Q
|
|---|
