Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: YTQAPI6

YTQAPI6.m

Go to the documentation of this file.
  1. 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
  1. ;
  1. ;Reference to ^XLFDT APIs supported by DBIA #10103
  1. GAFRET(YSDATA,YS) ;
  1. N YSBEG,YSEND,YSLIMIT,N,DFN,%DT
  1. K YSDATA
  1. D PARSE(.YS)
  1. I DFN'>0 S YSDATA(1)="[ERROR]",YSDATA(2)="No dfn" Q
  1. S YSDATA(1)="[DATA]"
  1. S N=1
  1. D RETHX
  1. Q
  1. PARSE(YS) ; -- array parsing
  1. S DFN=$G(YS("DFN"),0)
  1. S YSBEG=$G(YS("BEGIN"),"01/01/1970") S X=YSBEG,%DT="X" D ^%DT S YSBEG=Y
  1. S YSEND=$G(YS("END"),"01/01/2500") S X=YSEND,%DT="X" D ^%DT S YSEND=Y
  1. S YSLIMIT=$G(YS("LIMIT"),9999)
  1. Q
  1. RETHX ;
  1. N YSJJ,YSDD,X,Y,YSX,YSN
  1. S YSDD=9999999-YSEND-.00001
  1. F YSJJ=1:1:YSLIMIT S YSDD=$O(^YSD(627.8,"AX5",DFN,YSDD)) Q:YSDD'>0!(YSDD>(9999999-YSBEG)) D
  1. . S YSN=0 F S YSN=$O(^YSD(627.8,"AX5",DFN,YSDD,YSN)) Q:YSN'>0 D
  1. .. S YSX=$P($G(^YSD(627.8,YSN,60)),U,3)
  1. .. S Y=$P($G(^YSD(627.8,YSN,0)),U,3)
  1. .. 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))
  1. .. D SET(YSX)
  1. Q
  1. SET(X) ;
  1. S N=N+1
  1. S YSDATA(N)=X
  1. Q
  1. DELETEME(YSDATA,YS) ;delete a test
  1. ;removes 601.71 and 601.76 entries only
  1. ;input: CODE as test name
  1. ;output: DATA vs ERROR
  1. N YSTESTN,YSTEST,YSHASOP,DA,DIK
  1. S YSTEST=$G(YS("CODE"))
  1. I YSTEST="" S YSDATA(1)="[ERROR]",YSDATA(2)="NO code" Q ;-->out
  1. S YSTESTN=$O(^YTT(601.71,"B",YSTEST,0))
  1. I YSTESTN'>0 S YSDATA(1)="[ERROR]",YSDATA(2)="bad code" Q ;-->out
  1. S YSHASOP=$P($G(^YTT(601.71,YSTESTN,2)),U,5)
  1. I YSHASOP="Y" S YSDATA(1)="[ERROR]",YSDATA(2)="has been operational" Q ;--> out
  1. S DA=YSTESTN,DIK="^YTT(601.71," D ^DIK
  1. S DIK="^YTT(601.76,"
  1. S DA=0 F S DA=$O(^YTT(601.76,"AC",YSTESTN,DA)) Q:DA'>0 D ^DIK
  1. S YSDATA(1)="[DATA]"
  1. Q
  1. DELENTRY(YSDATA,YS) ;delete file entry
  1. ;entry point for YTQ DELETE ENTRY rpc
  1. ;input: YS("FILE")=file number (e.g., 627.8)
  1. ; YS("IEN")=file IEN (e.g., 100123)
  1. ;output: DATA vs ERROR
  1. N YSERR,YSFILE,YSIEN,YSREF,YSTA,DA,DIK
  1. S YSFILE=+$G(YS("FILE"))
  1. Q:YSFILE<601 Q:YSFILE>630 ; restrict to Mental Health files
  1. I 'YSFILE S YSDATA(1)="[ERROR]",YSDATA(2)="NO FILE NUMBER" Q ;-->out
  1. S YSIEN=$G(YS("IEN"))
  1. I 'YSIEN S YSDATA(1)="[ERROR]",YSDATA(2)="BAD IEN" Q ;-->out
  1. D FILE^DID(YSFILE,,"GLOBAL NAME","YSTA","YSERR")
  1. I $D(YSERR("DIERR")) S YSDATA(1)="[ERROR]",YSDATA(2)=YSERR("DIERR",1,"TEXT",1) Q ;out
  1. S YSREF=YSTA("GLOBAL NAME")_YSIEN_",0)"
  1. I '$D(@(YSREF)) S YSDATA(1)="[ERROR]",YSDATA(2)="ENTRY NOT FOUND" Q ;-->out
  1. S DA=YSIEN,DIK=YSTA("GLOBAL NAME") D ^DIK
  1. S YSDATA(1)="[DATA]"
  1. Q