- YSUTL ;SLC/DKG-UTILITIES FOR PT DATA, DATES, ETC. ;7/18/91 08:51 ;
- ;;5.01;MENTAL HEALTH;**23,187**;Dec 30, 1994;Build 73
- ;
- ENDD ; Called by routines YSCEN1, YSCEN22, YSCEN33, YSCEN54, YSCEN7, YSHX1
- ; YSHX1R, YSMV1, YSPHY, YSPRBR1, YSPROBR, YSPTX, YSPTXR
- ; Formats date for time-stamping entry of patient data
- I '$D(Y) D
- .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
- 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
- Q
- ENDTM ; Called by routines YSCEN, YSCEN1, YSCEN2, YSCEN21, YSCEN34, YSCEN55
- ; YSCEN56, YSCEN6, YSCEN61, YSCHX1, YSLOCN, YSMV, YSPROB, YSPROB2
- ; YSPROB4, YSPTX1
- ;
- S %=$P($H,",",2),%=%#3600\60/100+(%\3600)/100 S YSDTM=DT_% K % D ENDD,ENHM K A,M,X,Y,YSHM,YSHR,YSMN
- Q
- ENHM ; Called by routine YSCEN22, YSMV1
- D:'$D(YSDTM) ENDTM S:'$D(YSHM) YSHM=$P(YSDTM,".",2) S YSMN=$E(YSHM,3,4) S:$L(YSMN)=1 YSMN=YSMN_"0"
- 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"
- K A,M Q
- ENBUL ;
- ;This was modified on 11/22/96 - removed call to ^DIE
- S DIC=3.8,DIC(0)="MZ",X="YS PSYCHTEST" D ^DIC Q:Y'>0
- Q:'$D(YSORD)
- I '$D(YSDT(1)) K Y D ENDTM
- 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
- Q
- WAIT ; Called by routine YSCEN4, YSDGDEM0, YSDX3RU, YSDXR, YSPDXR, YSSR,
- ; YSPROBR1, YSWX, YSPN2
- F I0=1:1:IOSL-$Y-4 W !
- N DTOUT,DUOUT,DIRUT
- S DIR(0)="E" D ^DIR K DIR S YSTOUT=$D(DTOUT),YSUOUT=$D(DUOUT),YSLFT=$D(DIRUT)
- W @IOF Q
- ;
- WAIT1 ; Called by routine YSPP, YSPP1, YSPP1A, YSPP3, YSPP4, YSPP5, YSPP6
- ; YSPP7, YSPP8, YSPP9
- F I0=1:1:IOSL-$Y-2 W !
- WAIT11 ;
- ; %%%%FIND YSLFT AND USE YSTOUT OR YSUOUT %%%%%%
- S YSLFT=0
- R !,"Press return to continue or ""^"" to escape or ""^N"" for section ""N"" ",YSSKIP:DTIME
- S YSTOUT='$T,YSUOUT=YSSKIP="^" I YSTOUT!YSUOUT S YSLFT=1 Q
- 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
- 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_","
- Q
- AE ;
- K %,%Y,D,D0,DIC,DA,DIE,DQ,DR,DZ,X,Y,Z Q
- Q
- PSIG ; Called by routines YSCEN33, YSHX1R, YSPHYR, YSPP7, YSPROBR1, YSPRXR
- S Y="" S:X Y=$P($G(^VA(200,X,0)),U)
- Q
- ENPT ; Called by routines YSCEN1, YSCEN2, YSCEN23, YSCEN32, YSCEN33, YSCEN34
- ; YSCEN35, YSCEN38, YSCEN39, YSCEN52, YSCEN54, YSCEN61, YSPP7, YSUTL
- ;
- D KVAR^VADPT S DFN=YSDFN D DEM^VADPT,PID^VADPT
- S YSNM=VADM(1),YSSEX=$P(VADM(5),U),YSDOB=$P(VADM(3),U,2),YSAGE=VADM(4),YSSSN="xxx-xx-"_VA("BID"),YSBID=VA("BID") K X Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HYSUTL 3072 printed Jan 18, 2025@03:16:08 Page 2
- YSUTL ;SLC/DKG-UTILITIES FOR PT DATA, DATES, ETC. ;7/18/91 08:51 ;
- +1 ;;5.01;MENTAL HEALTH;**23,187**;Dec 30, 1994;Build 73
- +2 ;
- ENDD ; Called by routines YSCEN1, YSCEN22, YSCEN33, YSCEN54, YSCEN7, YSHX1
- +1 ; YSHX1R, YSMV1, YSPHY, YSPRBR1, YSPROBR, YSPTX, YSPTXR
- +2 ; Formats date for time-stamping entry of patient data
- +3 IF '$DATA(Y)
- Begin DoDot:1
- +4 SET %=$HOROLOG>21549+$HOROLOG-.1
- SET %Y=%\365.25+141
- SET %=%#365.25\1
- SET YSPTD=%+306#(%Y#4=0+365)#153#61#31+1
- SET YSPTM=%-YSPTD\29+1
- SET Y=%Y_"00"+YSPTM_"00"+YSPTD
- SET YSDT(0)=$EXTRACT(Y,4,5)_"/"_$EXTRACT(Y,6,7)_"/"_$EXTRACT(Y,2,3)
- KILL %,%Y,YSPTD,YSPTM
- End DoDot:1
- +5 SET Y=$EXTRACT("JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC",$EXTRACT(Y,4,5)*3-2,$EXTRACT(Y,4,5)*3)_" "_$SELECT(Y#100:$JUSTIFY(Y#100\1,2)_", ",1:"")_(Y\10000+1700)_$SELECT(Y#1:" "_$EXTRACT(Y_0,9,10)_":"_$EXTRACT(Y_"000",11,12),1:"")
- SET YSDT(1)=Y
- +6 QUIT
- ENDTM ; Called by routines YSCEN, YSCEN1, YSCEN2, YSCEN21, YSCEN34, YSCEN55
- +1 ; YSCEN56, YSCEN6, YSCEN61, YSCHX1, YSLOCN, YSMV, YSPROB, YSPROB2
- +2 ; YSPROB4, YSPTX1
- +3 ;
- +4 SET %=$PIECE($HOROLOG,",",2)
- SET %=%#3600\60/100+(%\3600)/100
- SET YSDTM=DT_%
- KILL %
- DO ENDD
- DO ENHM
- KILL A,M,X,Y,YSHM,YSHR,YSMN
- +5 QUIT
- ENHM ; Called by routine YSCEN22, YSMV1
- +1 if '$DATA(YSDTM)
- DO ENDTM
- if '$DATA(YSHM)
- SET YSHM=$PIECE(YSDTM,".",2)
- SET YSMN=$EXTRACT(YSHM,3,4)
- if $LENGTH(YSMN)=1
- SET YSMN=YSMN_"0"
- +2 SET YSHR=$EXTRACT(YSHM,1,2)
- SET A=$SELECT(YSHR<12:YSHR,YSHR>12:YSHR-12,YSHR=12:12,1:"00")
- SET M=$SELECT(YSHR<12:"A",YSHR=12&(YSMN>0):"P",YSHR>12:"P",1:0)
- if A?1"0".N
- SET A=" "_$EXTRACT(A,2)
- if $LENGTH(A)=1
- SET A=" "_A
- SET YSTM=A_":"_YSMN_" "_M_"M"
- +3 KILL A,M
- QUIT
- ENBUL ;
- +1 ;This was modified on 11/22/96 - removed call to ^DIE
- +2 SET DIC=3.8
- SET DIC(0)="MZ"
- SET X="YS PSYCHTEST"
- DO ^DIC
- if Y'>0
- QUIT
- +3 if '$DATA(YSORD)
- QUIT
- +4 IF '$DATA(YSDT(1))
- KILL Y
- DO ENDTM
- +5 SET XMB="YS PSYCHTEST"
- SET XMB(1)=$PIECE(^DPT(YSDFN,0),U)
- SET XMB(2)=$PIECE(^VA(200,DUZ,0),U)
- SET XMB(3)=YSDT(1)
- SET XMB(4)=""
- if YSORD]""
- SET XMB(4)=$PIECE(^VA(200,YSORD,0),U)
- SET XMY(YSORD)=""
- SET XMDUZ=DUZ
- DO EN^XMB
- +6 QUIT
- WAIT ; Called by routine YSCEN4, YSDGDEM0, YSDX3RU, YSDXR, YSPDXR, YSSR,
- +1 ; YSPROBR1, YSWX, YSPN2
- +2 FOR I0=1:1:IOSL-$Y-4
- WRITE !
- +3 NEW DTOUT,DUOUT,DIRUT
- +4 SET DIR(0)="E"
- DO ^DIR
- KILL DIR
- SET YSTOUT=$DATA(DTOUT)
- SET YSUOUT=$DATA(DUOUT)
- SET YSLFT=$DATA(DIRUT)
- +5 WRITE @IOF
- QUIT
- +6 ;
- WAIT1 ; Called by routine YSPP, YSPP1, YSPP1A, YSPP3, YSPP4, YSPP5, YSPP6
- +1 ; YSPP7, YSPP8, YSPP9
- +2 FOR I0=1:1:IOSL-$Y-2
- WRITE !
- WAIT11 ;
- +1 ; %%%%FIND YSLFT AND USE YSTOUT OR YSUOUT %%%%%%
- +2 SET YSLFT=0
- +3 READ !,"Press return to continue or ""^"" to escape or ""^N"" for section ""N"" ",YSSKIP:DTIME
- +4 SET YSTOUT='$TEST
- SET YSUOUT=YSSKIP="^"
- IF YSTOUT!YSUOUT
- SET YSLFT=1
- QUIT
- +5 IF YSSKIP["?"
- WRITE !!,"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.",!!
- GOTO WAIT11
- +6 IF YSSKIP?1"^"1N.N
- SET X=$EXTRACT(YSSKIP,2,3)
- IF X>0
- IF X<11
- SET YSA8=""
- SET YSI=0
- FOR I=X:1:10
- SET YSA8=YSA8_I_","
- +7 QUIT
- AE ;
- +1 KILL %,%Y,D,D0,DIC,DA,DIE,DQ,DR,DZ,X,Y,Z
- QUIT
- +2 QUIT
- PSIG ; Called by routines YSCEN33, YSHX1R, YSPHYR, YSPP7, YSPROBR1, YSPRXR
- +1 SET Y=""
- if X
- SET Y=$PIECE($GET(^VA(200,X,0)),U)
- +2 QUIT
- ENPT ; Called by routines YSCEN1, YSCEN2, YSCEN23, YSCEN32, YSCEN33, YSCEN34
- +1 ; YSCEN35, YSCEN38, YSCEN39, YSCEN52, YSCEN54, YSCEN61, YSPP7, YSUTL
- +2 ;
- +3 DO KVAR^VADPT
- SET DFN=YSDFN
- DO DEM^VADPT
- DO PID^VADPT
- +4 SET YSNM=VADM(1)
- SET YSSEX=$PIECE(VADM(5),U)
- SET YSDOB=$PIECE(VADM(3),U,2)
- SET YSAGE=VADM(4)
- SET YSSSN="xxx-xx-"_VA("BID")
- SET YSBID=VA("BID")
- KILL X
- QUIT