84 lines
3.5 KiB
Mathematica
84 lines
3.5 KiB
Mathematica
YTAPI7 ;ASF/ALB- PSYCH TEST API INCOMPLETES ;5/9/01 16:55
|
|
;;5.01;MENTAL HEALTH;**71**;Dec 30, 1994
|
|
SAVEINC(YSDATA,YS) ; save incomplete admins
|
|
N B,R1,R2,R3,DA,DIK,YSNEXT,X,Y,N1,YSADATE,DFN,YSCODE,YSNEXT,YSORDER
|
|
D PARSE(.YS)
|
|
I '$D(DFN) S YSDATA(1)="[ERROR]",YSDATA(2)="no pt dfn" Q ;--->OUT
|
|
I '$D(YSNEXT) S YSDATA(1)="[ERROR]",YSDATA(2)="no next" Q ;---> OUT
|
|
I YSCODE=""!'$D(^YTT(601,YSCODE)) S YSDATA(1)="[ERROR]",YSADTA(2)="bad test code" Q ;--->OUT
|
|
I YSORDER'?1N.N S YSDATA(1)="[ERROR]",YSADTA(2)="bad ORDERED BY" Q ;--->OUT
|
|
SAV1 ;
|
|
L +^YTD(601.4,DFN):0 Q:'$T
|
|
I '$D(^YTD(601.4,DFN,0)) D NEWPT ;add at dfn level
|
|
S $P(^YTD(601.4,DFN,1,0),U,2)="601.4P"
|
|
S:YSCODE>$P(^YTD(601.4,DFN,1,0),U,3) $P(^YTD(601.4,DFN,1,0),U,3)=YSCODE
|
|
S $P(^YTD(601.4,DFN,1,0),U,4)=$P(^YTD(601.4,DFN,1,0),U,4)+1
|
|
S ^YTD(601.4,DFN,1,YSCODE,0)=YSCODE_"^"_YSADATE_"^^"_YSNEXT_"^"_$P($G(^YTT(601,YSCODE,"Q",YSNEXT,0)),U,2)_"^^"_YSORDER
|
|
S:$P(^YTD(601.4,DFN,1,YSCODE,0),U,8)="" $P(^YTD(601.4,DFN,1,YSCODE,0),U,8)=DT
|
|
S B="",N1=YSNEXT+.1 ;bottom text
|
|
F S N1=$O(^YTT(601,YSCODE,"Q",N1),-1) Q:N1'>0 S B=$G(^YTT(601,YSCODE,"Q",N1,"B")) Q:$D(^YTT(601,YSCODE,"Q",N1,"B"))
|
|
I $L(B) S ^YTD(601.4,DFN,1,YSCODE,"B")=B
|
|
S ^YTD(601.4,DFN,1,YSCODE,1)=R1
|
|
S ^YTD(601.4,DFN,1,YSCODE,2)=R2
|
|
S ^YTD(601.4,DFN,1,YSCODE,3)=R3
|
|
S DIK="^YTD(601.4,",DA=DFN D IX^DIK ;reindex
|
|
L -^YTD(601.4,DFN)
|
|
S YSDATA(1)="[DATA]",YSDATA(2)="saved ok"
|
|
Q
|
|
NEWPT ;new entry to 601.4
|
|
L +^YTD(601.4,0):0 Q:'$T
|
|
S X=^YTD(601.4,0),X(4)=$P(X,U,4),X(3)=$P(X,U,3),X(4)=X(4)+1
|
|
S:DFN>X(3) X(3)=DFN
|
|
S X=$P(X,U,1,2)_"^"_X(3)_"^"_X(4)
|
|
S ^YTD(601.4,0)=X,^YTD(601.4,DFN,0)=DFN,^YTD(601.4,"B",DFN,DFN)=""
|
|
L -^YTD(601.4,0)
|
|
Q
|
|
LISTINC(YSDATA,YS) ;list all incompletes for a pt
|
|
N DFN,YSCODE,YSCODEN,X,Y,N,N1,G,YSL,YSADATE,YTLM,YSRSLMT
|
|
S YSRSLMT=$P($G(^YSA(602,1,0)),U,3)
|
|
S DFN=$G(YS("DFN"))
|
|
I '$D(DFN) S YSDATA(1)="[ERROR]",YSDATA(2)="no pt dfn" Q ;--->OUT
|
|
S YSDATA(1)="[DATA]"
|
|
S N1=0 F S N1=$O(^YTD(601.4,DFN,1,N1)) Q:N1'>0 D
|
|
. S G=^YTD(601.4,DFN,1,N1,0)
|
|
. S YSCODE=N1,YSCODEN=$P($G(^YTT(601,N1,0)),U)
|
|
. S:YSCODEN?1"CLERK".E YSCODE=$P(G,U,6) S:YSCODE>0 YSCODEN=$P(^YTT(601,YSCODE,0),U)
|
|
. Q:$P(^YTT(601,YSCODE,0),U,9)'="T" ;--> OUT ASF 4/27/01
|
|
. S YSL(YSCODEN)=YSCODEN
|
|
. S (YSADATE,Y)=$P(G,U,2) D DD^%DT S $P(YSL(YSCODEN),U,2)=Y
|
|
. S YTLM=YSRSLMT
|
|
. I $P($G(^YTT(601,YSCODE,0)),U,16) S YTLM=$P(^(0),U,16)
|
|
. S X=$$FMDIFF^XLFDT(DT,YSADATE,1)
|
|
. S $P(YSL(YSCODEN),U,3)=$S(X>YTLM:"not restartable",1:"restartable")
|
|
S N1=0,N=0 F S N1=$O(YSL(N1)) Q:N1="" D
|
|
. S N=N+1
|
|
. S YSDATA(N)=YSL(N1)
|
|
Q
|
|
GETINC(YSDATA,YS) ;get saved data
|
|
N DFN,YSCODE,YSCLERK,YSCLERKN,YSENT
|
|
D PARSE(.YS)
|
|
I '$D(DFN) S YSDATA(1)="[ERROR]",YSDATA(2)="no pt dfn" Q ;--->OUT
|
|
I YSCODE=""!'$D(^YTT(601,YSCODE)) S YSDATA(1)="[ERROR]",YSADTA(2)="bad test code" Q ;--->OUT
|
|
I '$D(^YTD(601.4,DFN)) S YSDATA(1)="[ERROR]",YSDATA(2)="no inc for dfn" Q ;--> OUT
|
|
S YSCLERK=$O(^YTT(601,"B","CLERK",0))
|
|
S YSCLERKN=$P($G(^YTD(601.4,DFN,1,YSCLERK,0)),U,6)
|
|
I '$D(^YTD(601.4,DFN,1,YSCODE))&(YSCODE'=YSCLERKN) S YSDATA(1)="[ERROR]",YSDATA(2)="no data for test" Q ;-->OUT
|
|
S YSENT=$S(YSCODE=YSCLERKN:YSCLERK,1:YSCODE)
|
|
S YSDATA(1)="[DATA]"
|
|
S YSDATA(2)=^YTD(601.4,DFN,1,YSENT,0)
|
|
S YSDATA(3)=$G(^YTD(601.4,DFN,1,YSENT,1))
|
|
S YSDATA(4)=$G(^YTD(601.4,DFN,1,YSENT,2))
|
|
S YSDATA(5)=$G(^YTD(601.4,DFN,1,YSENT,3))
|
|
Q
|
|
PARSE(YS) ; -- array parsing
|
|
S DFN=$G(YS("DFN"))
|
|
S YSCODE=$G(YS("CODE"),"ERROR")
|
|
S:YSCODE'?1N.N YSCODE=$O(^YTT(601,"B",YSCODE,0))
|
|
S YSADATE=$G(YS("ADATE")) S X=YSADATE D ^%DT S YSADATE=Y
|
|
S YSORDER=$G(YS("ORDERBY"))
|
|
S YSNEXT=$G(YS("NEXT"))
|
|
S R1=$G(YS("R1"))
|
|
S R2=$G(YS("R2"))
|
|
S R3=$G(YS("R3"))
|
|
Q
|