| 1 | YSUTL ;SLC/DKG-UTILITIES FOR PT DATA, DATES, ETC. ;7/18/91 08:51 ;
|
|---|
| 2 | ;;5.01;MENTAL HEALTH;**23**;Dec 30, 1994
|
|---|
| 3 | ;
|
|---|
| 4 | ENDD ; Called by routines YSCEN1, YSCEN22, YSCEN33, YSCEN54, YSCEN7, YSHX1
|
|---|
| 5 | ; YSHX1R, YSMV1, YSPHY, YSPRBR1, YSPROBR, YSPTX, YSPTXR
|
|---|
| 6 | ; Formats date for time-stamping entry of patient data
|
|---|
| 7 | I '$D(Y) D
|
|---|
| 8 | .S %=$H>21549+$H-.1,%Y=%\365.25+141,%=%#365.25\1,YSPTD=%+306#(%Y#4=0+365)#153#61#31+1,YSPTM=%-YSPTD\29+1,Y=%Y_"00"+YSPTM_"00"+YSPTD,YSDT(0)=$E(Y,4,5)_"/"_$E(Y,6,7)_"/"_$E(Y,2,3) K %,%Y,YSPTD,YSPTM
|
|---|
| 9 | S Y=$E("JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC",$E(Y,4,5)*3-2,$E(Y,4,5)*3)_" "_$S(Y#100:$J(Y#100\1,2)_", ",1:"")_(Y\10000+1700)_$S(Y#1:" "_$E(Y_0,9,10)_":"_$E(Y_"000",11,12),1:""),YSDT(1)=Y
|
|---|
| 10 | Q
|
|---|
| 11 | ENDTM ; Called by routines YSCEN, YSCEN1, YSCEN2, YSCEN21, YSCEN34, YSCEN55
|
|---|
| 12 | ; YSCEN56, YSCEN6, YSCEN61, YSCHX1, YSLOCN, YSMV, YSPROB, YSPROB2
|
|---|
| 13 | ; YSPROB4, YSPTX1
|
|---|
| 14 | ;
|
|---|
| 15 | S %=$P($H,",",2),%=%#3600\60/100+(%\3600)/100 S YSDTM=DT_% K % D ENDD,ENHM K A,M,X,Y,YSHM,YSHR,YSMN
|
|---|
| 16 | Q
|
|---|
| 17 | ENHM ; Called by routine YSCEN22, YSMV1
|
|---|
| 18 | D:'$D(YSDTM) ENDTM S:'$D(YSHM) YSHM=$P(YSDTM,".",2) S YSMN=$E(YSHM,3,4) S:$L(YSMN)=1 YSMN=YSMN_"0"
|
|---|
| 19 | S YSHR=$E(YSHM,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) S:A?1"0".N A=" "_$E(A,2) S:$L(A)=1 A=" "_A S YSTM=A_":"_YSMN_" "_M_"M"
|
|---|
| 20 | K A,M Q
|
|---|
| 21 | ENBUL ;
|
|---|
| 22 | ;This was modified on 11/22/96 - removed call to ^DIE
|
|---|
| 23 | S DIC=3.8,DIC(0)="MZ",X="YS PSYCHTEST" D ^DIC Q:Y'>0
|
|---|
| 24 | Q:'$D(YSORD)
|
|---|
| 25 | I '$D(YSDT(1)) K Y D ENDTM
|
|---|
| 26 | S XMB="YS PSYCHTEST",XMB(1)=$P(^DPT(YSDFN,0),U),XMB(2)=$P(^VA(200,DUZ,0),U),XMB(3)=YSDT(1) S XMB(4)="" S:YSORD]"" XMB(4)=$P(^VA(200,YSORD,0),U),XMY(YSORD)="" S XMDUZ=DUZ D EN^XMB
|
|---|
| 27 | Q
|
|---|
| 28 | WAIT ; Called by routine YSCEN4, YSDGDEM0, YSDX3RU, YSDXR, YSPDXR, YSSR,
|
|---|
| 29 | ; YSPROBR1, YSWX, YSPN2
|
|---|
| 30 | F I0=1:1:IOSL-$Y-4 W !
|
|---|
| 31 | N DTOUT,DUOUT,DIRUT
|
|---|
| 32 | S DIR(0)="E" D ^DIR K DIR S YSTOUT=$D(DTOUT),YSUOUT=$D(DUOUT),YSLFT=$D(DIRUT)
|
|---|
| 33 | W @IOF Q
|
|---|
| 34 | ;
|
|---|
| 35 | WAIT1 ; Called by routine YSPP, YSPP1, YSPP1A, YSPP3, YSPP4, YSPP5, YSPP6
|
|---|
| 36 | ; YSPP7, YSPP8, YSPP9
|
|---|
| 37 | F I0=1:1:IOSL-$Y-2 W !
|
|---|
| 38 | WAIT11 ;
|
|---|
| 39 | ; %%%%FIND YSLFT AND USE YSTOUT OR YSUOUT %%%%%%
|
|---|
| 40 | S YSLFT=0
|
|---|
| 41 | R !,"Press return to continue or ""^"" to escape or ""^N"" for section ""N"" ",YSSKIP:DTIME
|
|---|
| 42 | S YSTOUT='$T,YSUOUT=YSSKIP="^" I YSTOUT!YSUOUT S YSLFT=1 Q
|
|---|
| 43 | I YSSKIP["?" W !!,"To select different ""areas of info"", enter ""^N"" where ""N"" is set to the following area you want. Ex. enter ""^3"" to go to the 3rd screen.",!! G WAIT11
|
|---|
| 44 | I YSSKIP?1"^"1N.N S X=$E(YSSKIP,2,3) I X>0,X<11 S YSA8="",YSI=0 F I=X:1:10 S YSA8=YSA8_I_","
|
|---|
| 45 | Q
|
|---|
| 46 | AE ;
|
|---|
| 47 | K %,%Y,D,D0,DIC,DA,DIE,DQ,DR,DZ,X,Y,Z Q
|
|---|
| 48 | Q
|
|---|
| 49 | PSIG ; Called by routines YSCEN33, YSHX1R, YSPHYR, YSPP7, YSPROBR1, YSPRXR
|
|---|
| 50 | S Y="" S:X Y=$P($G(^VA(200,X,0)),U)
|
|---|
| 51 | Q
|
|---|
| 52 | ENPT ; Called by routines YSCEN1, YSCEN2, YSCEN23, YSCEN32, YSCEN33, YSCEN34
|
|---|
| 53 | ; YSCEN35, YSCEN38, YSCEN39, YSCEN52, YSCEN54, YSCEN61, YSPP7, YSUTL
|
|---|
| 54 | ;
|
|---|
| 55 | D KVAR^VADPT S DFN=YSDFN D DEM^VADPT,PID^VADPT
|
|---|
| 56 | S YSNM=VADM(1),YSSEX=$P(VADM(5),U),YSDOB=$P(VADM(3),U,2),YSAGE=VADM(4),YSSSN=VA("PID"),YSBID=VA("BID") K X Q
|
|---|
