- 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 Jan 18, 2025@03:19:29 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