144 lines
4.7 KiB
Mathematica
144 lines
4.7 KiB
Mathematica
YSDX3UB ;SLC/DJP/LJA-Continuation of Utilities for Diagnosis Entry in the MH Medical Record ;09/07/94 13:11
|
|
;;5.01;MENTAL HEALTH;;Dec 30, 1994
|
|
;D RECORD^YSDX0001("^YSDX3UB") ;Used for testing. Inactivated in YSDX0001...
|
|
;
|
|
MODIF ; Called by routine YSDX3
|
|
; Print out modifier questions
|
|
;D RECORD^YSDX0001("MODIF^YSDX3UB") ;Used for testing. Inactivated in YSDX0001...
|
|
QUIT:'$D(^YSD(627.7,YSDXDA1,"Q",0)) ;->
|
|
W !!,"MODIFIERS: "
|
|
S K1=0
|
|
F K YSQT S K1=$O(^YSD(627.7,+YSDXDA1,"Q",K1)) Q:'K1 D I $D(YSQT) D DELETE^YSDX3UA QUIT ;->
|
|
. S K2=$P(^YSD(627.7,+YSDXDA1,"Q",+K1,0),U)
|
|
. D MQUES
|
|
. S:K2=36 YSALZ=1
|
|
QUIT
|
|
MQUES ;
|
|
;D RECORD^YSDX0001("MQUES^YSDX3UB") ;Used for testing. Inactivated in YSDX0001...
|
|
N YSTEST
|
|
S YSMODI=$P(^DIC(627.9,+K2,0),U,2)
|
|
;
|
|
; Set YSQIEN and check if is info only, or query... Exit if info only.
|
|
S YSQIEN=+K2
|
|
I '$D(^DIC(627.9,+YSQIEN,1)) D QUIT ;->
|
|
. S YSX=$P($G(^DIC(627.9,+YSQIEN,0)),U,2)
|
|
. W:YSX]"" !!,YSX
|
|
;
|
|
; Display prompt and get specifier...
|
|
D ASKQUAL^YSDX3UC
|
|
;
|
|
; Various QUITs...
|
|
I '$G(YSOK) S YSQT=1 QUIT ;-> YSOK set by ASKQUAL^YSDX3UC
|
|
I YSTOUT!YSUOUT S YSQT=1 QUIT ;->
|
|
I '$D(^DIC(627.9,+YSQIEN,1,"B")) S YSQT=1 QUIT ;->
|
|
I '$D(YSQCH) QUIT ;-> Do NOT set YSQT. User just did not select anything...
|
|
;
|
|
D MSET ; Store selected modifier(s) in 627.8...
|
|
;
|
|
QUIT
|
|
;
|
|
DQP(YSPEC) ; Display Qualifier Prompt (Specifier)
|
|
; Note: Cursor should be at beginning of line when DQP call made.
|
|
QUIT:$G(YSPEC)']"" ;->
|
|
N YSX,YSY,YSZ
|
|
;
|
|
; Change =s to .s
|
|
S YSZ("=")=". "
|
|
S YSZ(" - :")=":"
|
|
S YSPEC=$$REPLACE^XLFSTR(YSPEC,.YSZ)
|
|
;
|
|
; Itemized specifiers text...
|
|
I YSPEC[":" D QUIT ;->
|
|
. D DQP1($P(YSPEC,":")) W ":" ;Print prompt
|
|
. S YSPEC=$P(YSPEC,":",2,99) ;Cut off prompt
|
|
. F QUIT:$E(YSPEC)'=" " S YSPEC=$E(YSPEC,2,999) ;Trim leading spaces
|
|
.
|
|
. W:$X>9 ! W ?10
|
|
. F YSX=1:1:$L(YSPEC,";") S YSY=$P(YSPEC,";",+YSX) I YSY]"" D
|
|
. . F QUIT:$E(YSY)'=" " S YSY=$E(YSY,2,999) ;Trim leading spaces
|
|
. . I $L(YSY)<(IOM-13) W YSY,!,?10 QUIT ;->
|
|
. . F YSI=(IOM-13):-1:1 QUIT:$E(YSY,YSI)=" "
|
|
. . S YSI=$S(YSI:YSI,1:IOM-13)
|
|
. . W $E(YSY,1,YSI),!,?13,$E(YSY,YSI+1,999)
|
|
. . W !,?10
|
|
;
|
|
; Non-itemized specifiers text...
|
|
I $E(YSPEC,1,8)'[":" D DQP1(YSPEC)
|
|
QUIT
|
|
;
|
|
DQP1(YSPEC) ;Print prompt with proper wrapping...
|
|
; After call, cursor is left at end of last line...
|
|
QUIT:$G(YSPEC)']"" ;->
|
|
W:$X>1 !
|
|
N YSX
|
|
F D QUIT:YSPEC']"" ;->
|
|
. I $L(YSPEC)<(IOM) W YSPEC S YSPEC="" QUIT ;->
|
|
. F YSX=IOM:-1:1 QUIT:$E(YSPEC,YSX)=" "
|
|
. S YSX=$S(YSX:YSX,1:$L(YSPEC))
|
|
. W $E(YSPEC,1,+YSX)
|
|
. S YSPEC=$E(YSPEC,+YSX+1,999)
|
|
. W:YSPEC]"" ! ;More to print, so have to insert a line feed...
|
|
QUIT
|
|
;
|
|
YN ;
|
|
;D RECORD^YSDX0001("YN^YSDX3UB") ;Used for testing. Inactivated in YSDX0001...
|
|
S K3=$TR(K3,"yn","YN")
|
|
I K3["?" D QUIT ;->
|
|
. W !!,"Diagnosis may be modified. Answer ""YES"" or ""NO""."
|
|
. S K5=1
|
|
I "Y"'[K3&("N"'[K3) W "??" S K5=1 QUIT ;->
|
|
I "Y"[K3 S K3=1
|
|
I "Y"'[K3 S K3=2
|
|
QUIT
|
|
;
|
|
NUM ;
|
|
;D RECORD^YSDX0001("NUM^YSDX3UB") ;Used for testing. Inactivated in YSDX0001...
|
|
I K3="?" D QUIT ;->
|
|
. W !!,"Diagnosis may be modified. Answer with corresponding numeric."
|
|
. S K5=1
|
|
I K3="??"&(K2=1) S XQH="YS-GEN MODIFIER" D EN^XQH S K5=1 QUIT ;->
|
|
I K3'?1.N W "??" S K5=1 QUIT ;->
|
|
S N=$P(^DIC(627.9,+K2,1,0),U,3)
|
|
I K3<1!(K3>N) W !!,"Answer with corresponding numeric." S K5=1 QUIT ;->
|
|
QUIT
|
|
;
|
|
MSET ;
|
|
;D RECORD^YSDX0001("MSET^YSDX3UB") ;Used for testing. Inactivated in YSDX0001...
|
|
; YSQCH( -- req
|
|
QUIT:'$D(YSQCH) ;->
|
|
N DA,DIE,DR,YSLP,YSQIEN,YSQSFOR,YSQUSEL
|
|
L +^YSD(627.8,YSDA)
|
|
S DIE="^YSD(627.8,",DA=YSDA
|
|
S YSLP="YSQCH"
|
|
F S YSLP=$Q(@YSLP) QUIT:YSLP'["YSQCH(" D
|
|
. S YSQIEN=+$P(YSLP,"(",2),YSQUSEL=$P($P(YSLP,",",2),")")
|
|
. QUIT:YSQIEN'>0!(YSQUSEL']"") ;->
|
|
. S X=@YSLP,YSQSFOR=$S($TR(X," ","")="":"",1:X)
|
|
. S DR="50///"_+YSQIEN
|
|
. S DR(2,627.82)="1///"_$TR(YSQUSEL,"""","")
|
|
. I YSQSFOR]"" S DR(2,627.82)=DR(2,627.82)_";2///"_YSQSFOR
|
|
. D ^DIE
|
|
L -^YSD(627.8,YSDA)
|
|
QUIT
|
|
;
|
|
GAF ; Called by routine YSDX3B, YSDX3RUA
|
|
; Calculates the highest GAF for the past year. YSGAF(X) stores scale^DA.
|
|
;D RECORD^YSDX0001("GAF^YSDX3UB") ;Used for testing. Inactivated in YSDX0001...
|
|
K G5 S (G,G2)=0
|
|
F S G=$O(^YSD(627.8,"AX5",YSDFN,G)) Q:'G D
|
|
. S G1=0
|
|
. F S G1=$O(^YSD(627.8,"AX5",YSDFN,G,G1)) Q:'G1 D GAF1
|
|
I $D(YSGAF) S G5=0 D
|
|
. F I=1:1:G2 S G6=$P(YSGAF(I),U) I G6>G5 S G5=G6,G10=$P(YSGAF(I),U,2)
|
|
. S Y=$P(^YSD(627.8,G10,0),U,3) D DD^%DT S G11=$P(Y,"@")
|
|
QUIT
|
|
;
|
|
GAF1 ;
|
|
;D RECORD^YSDX0001("GAF1^YSDX3UB") ;Used for testing. Inactivated in YSDX0001...
|
|
S %DT="",X="T" D ^%DT S G4=(Y-$P($P(^YSD(627.8,G1,0),U,3),"."))
|
|
QUIT:G4>10000 ;->
|
|
S G2=G2+1,YSGAF(G2)=$P(^YSD(627.8,G1,60),U,3)_"^"_G1
|
|
QUIT
|
|
;
|
|
EOR ;YSDX3UB-Continuation of Utilities for Diagnosis Entry in the MH Medical Record ;9/18/91 15:39
|