YTQAPI6 ;ALB/ASF,HIOFO/FT - GAF API,DELETES ; 8/15/11 10:05am
;;5.01;MENTAL HEALTH;**85,103,142**;Dec 30, 1994;Build 14
;
;Reference to ^XLFDT APIs supported by DBIA #10103
GAFRET(YSDATA,YS) ;
N YSBEG,YSEND,YSLIMIT,N,DFN,%DT
K YSDATA
D PARSE(.YS)
I DFN'>0 S YSDATA(1)="[ERROR]",YSDATA(2)="No dfn" Q
S YSDATA(1)="[DATA]"
S N=1
D RETHX
Q
PARSE(YS) ; -- array parsing
S DFN=$G(YS("DFN"),0)
S YSBEG=$G(YS("BEGIN"),"01/01/1970") S X=YSBEG,%DT="X" D ^%DT S YSBEG=Y
S YSEND=$G(YS("END"),"01/01/2500") S X=YSEND,%DT="X" D ^%DT S YSEND=Y
S YSLIMIT=$G(YS("LIMIT"),9999)
Q
RETHX ;
N YSJJ,YSDD,X,Y,YSX,YSN
S YSDD=9999999-YSEND-.00001
F YSJJ=1:1:YSLIMIT S YSDD=$O(^YSD(627.8,"AX5",DFN,YSDD)) Q:YSDD'>0!(YSDD>(9999999-YSBEG)) D
. S YSN=0 F S YSN=$O(^YSD(627.8,"AX5",DFN,YSDD,YSN)) Q:YSN'>0 D
.. S YSX=$P($G(^YSD(627.8,YSN,60)),U,3)
.. S Y=$P($G(^YSD(627.8,YSN,0)),U,3)
.. S YSX=YSN_"="_$$FMTE^XLFDT(Y,"5TZ")_U_YSX_U_$P(^YSD(627.8,YSN,0),U,4)_U_$$EXTERNAL^DILFD(627.8,.04,"",$P($G(^YSD(627.8,YSN,0)),U,4))_U_$G(^YSD(627.8,YSN,80,1,0))
.. D SET(YSX)
Q
SET(X) ;
S N=N+1
S YSDATA(N)=X
Q
DELETEME(YSDATA,YS) ;delete a test
;removes 601.71 and 601.76 entries only
;input: CODE as test name
;output: DATA vs ERROR
N YSTESTN,YSTEST,YSHASOP,DA,DIK
S YSTEST=$G(YS("CODE"))
I YSTEST="" S YSDATA(1)="[ERROR]",YSDATA(2)="NO code" Q ;-->out
S YSTESTN=$O(^YTT(601.71,"B",YSTEST,0))
I YSTESTN'>0 S YSDATA(1)="[ERROR]",YSDATA(2)="bad code" Q ;-->out
S YSHASOP=$P($G(^YTT(601.71,YSTESTN,2)),U,5)
I YSHASOP="Y" S YSDATA(1)="[ERROR]",YSDATA(2)="has been operational" Q ;--> out
S DA=YSTESTN,DIK="^YTT(601.71," D ^DIK
S DIK="^YTT(601.76,"
S DA=0 F S DA=$O(^YTT(601.76,"AC",YSTESTN,DA)) Q:DA'>0 D ^DIK
S YSDATA(1)="[DATA]"
Q
DELENTRY(YSDATA,YS) ;delete file entry
;entry point for YTQ DELETE ENTRY rpc
;input: YS("FILE")=file number (e.g., 627.8)
; YS("IEN")=file IEN (e.g., 100123)
;output: DATA vs ERROR
N YSERR,YSFILE,YSIEN,YSREF,YSTA,DA,DIK
S YSFILE=+$G(YS("FILE"))
Q:YSFILE<601 Q:YSFILE>630 ; restrict to Mental Health files
I 'YSFILE S YSDATA(1)="[ERROR]",YSDATA(2)="NO FILE NUMBER" Q ;-->out
S YSIEN=$G(YS("IEN"))
I 'YSIEN S YSDATA(1)="[ERROR]",YSDATA(2)="BAD IEN" Q ;-->out
D FILE^DID(YSFILE,,"GLOBAL NAME","YSTA","YSERR")
I $D(YSERR("DIERR")) S YSDATA(1)="[ERROR]",YSDATA(2)=YSERR("DIERR",1,"TEXT",1) Q ;out
S YSREF=YSTA("GLOBAL NAME")_YSIEN_",0)"
I '$D(@(YSREF)) S YSDATA(1)="[ERROR]",YSDATA(2)="ENTRY NOT FOUND" Q ;-->out
S DA=YSIEN,DIK=YSTA("GLOBAL NAME") D ^DIK
S YSDATA(1)="[DATA]"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HYTQAPI6 2611 printed Sep 23, 2025@19:54:27 Page 2
YTQAPI6 ;ALB/ASF,HIOFO/FT - GAF API,DELETES ; 8/15/11 10:05am
+1 ;;5.01;MENTAL HEALTH;**85,103,142**;Dec 30, 1994;Build 14
+2 ;
+3 ;Reference to ^XLFDT APIs supported by DBIA #10103
GAFRET(YSDATA,YS) ;
+1 NEW YSBEG,YSEND,YSLIMIT,N,DFN,%DT
+2 KILL YSDATA
+3 DO PARSE(.YS)
+4 IF DFN'>0
SET YSDATA(1)="[ERROR]"
SET YSDATA(2)="No dfn"
QUIT
+5 SET YSDATA(1)="[DATA]"
+6 SET N=1
+7 DO RETHX
+8 QUIT
PARSE(YS) ; -- array parsing
+1 SET DFN=$GET(YS("DFN"),0)
+2 SET YSBEG=$GET(YS("BEGIN"),"01/01/1970")
SET X=YSBEG
SET %DT="X"
DO ^%DT
SET YSBEG=Y
+3 SET YSEND=$GET(YS("END"),"01/01/2500")
SET X=YSEND
SET %DT="X"
DO ^%DT
SET YSEND=Y
+4 SET YSLIMIT=$GET(YS("LIMIT"),9999)
+5 QUIT
RETHX ;
+1 NEW YSJJ,YSDD,X,Y,YSX,YSN
+2 SET YSDD=9999999-YSEND-.00001
+3 FOR YSJJ=1:1:YSLIMIT
SET YSDD=$ORDER(^YSD(627.8,"AX5",DFN,YSDD))
if YSDD'>0!(YSDD>(9999999-YSBEG))
QUIT
Begin DoDot:1
+4 SET YSN=0
FOR
SET YSN=$ORDER(^YSD(627.8,"AX5",DFN,YSDD,YSN))
if YSN'>0
QUIT
Begin DoDot:2
+5 SET YSX=$PIECE($GET(^YSD(627.8,YSN,60)),U,3)
+6 SET Y=$PIECE($GET(^YSD(627.8,YSN,0)),U,3)
+7 SET YSX=YSN_"="_$$FMTE^XLFDT(Y,"5TZ")_U_YSX_U_$PIECE(^YSD(627.8,YSN,0),U,4)_U_$$EXTERNAL^DILFD(627.8,.04,"",$PIECE($GET(^YSD(627.8,YSN,0)),U,4))_U_$GET(^YSD(627.8,YSN,80,1,0))
+8 DO SET(YSX)
End DoDot:2
End DoDot:1
+9 QUIT
SET(X) ;
+1 SET N=N+1
+2 SET YSDATA(N)=X
+3 QUIT
DELETEME(YSDATA,YS) ;delete a test
+1 ;removes 601.71 and 601.76 entries only
+2 ;input: CODE as test name
+3 ;output: DATA vs ERROR
+4 NEW YSTESTN,YSTEST,YSHASOP,DA,DIK
+5 SET YSTEST=$GET(YS("CODE"))
+6 ;-->out
IF YSTEST=""
SET YSDATA(1)="[ERROR]"
SET YSDATA(2)="NO code"
QUIT
+7 SET YSTESTN=$ORDER(^YTT(601.71,"B",YSTEST,0))
+8 ;-->out
IF YSTESTN'>0
SET YSDATA(1)="[ERROR]"
SET YSDATA(2)="bad code"
QUIT
+9 SET YSHASOP=$PIECE($GET(^YTT(601.71,YSTESTN,2)),U,5)
+10 ;--> out
IF YSHASOP="Y"
SET YSDATA(1)="[ERROR]"
SET YSDATA(2)="has been operational"
QUIT
+11 SET DA=YSTESTN
SET DIK="^YTT(601.71,"
DO ^DIK
+12 SET DIK="^YTT(601.76,"
+13 SET DA=0
FOR
SET DA=$ORDER(^YTT(601.76,"AC",YSTESTN,DA))
if DA'>0
QUIT
DO ^DIK
+14 SET YSDATA(1)="[DATA]"
+15 QUIT
DELENTRY(YSDATA,YS) ;delete file entry
+1 ;entry point for YTQ DELETE ENTRY rpc
+2 ;input: YS("FILE")=file number (e.g., 627.8)
+3 ; YS("IEN")=file IEN (e.g., 100123)
+4 ;output: DATA vs ERROR
+5 NEW YSERR,YSFILE,YSIEN,YSREF,YSTA,DA,DIK
+6 SET YSFILE=+$GET(YS("FILE"))
+7 ; restrict to Mental Health files
if YSFILE<601
QUIT
if YSFILE>630
QUIT
+8 ;-->out
IF 'YSFILE
SET YSDATA(1)="[ERROR]"
SET YSDATA(2)="NO FILE NUMBER"
QUIT
+9 SET YSIEN=$GET(YS("IEN"))
+10 ;-->out
IF 'YSIEN
SET YSDATA(1)="[ERROR]"
SET YSDATA(2)="BAD IEN"
QUIT
+11 DO FILE^DID(YSFILE,,"GLOBAL NAME","YSTA","YSERR")
+12 ;out
IF $DATA(YSERR("DIERR"))
SET YSDATA(1)="[ERROR]"
SET YSDATA(2)=YSERR("DIERR",1,"TEXT",1)
QUIT
+13 SET YSREF=YSTA("GLOBAL NAME")_YSIEN_",0)"
+14 ;-->out
IF '$DATA(@(YSREF))
SET YSDATA(1)="[ERROR]"
SET YSDATA(2)="ENTRY NOT FOUND"
QUIT
+15 SET DA=YSIEN
SET DIK=YSTA("GLOBAL NAME")
DO ^DIK
+16 SET YSDATA(1)="[DATA]"
+17 QUIT
