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