YSGAFAPI ;ALB/ASF- GAF API ;2/7/02 15:57
;;5.01;MENTAL HEALTH;**53,71,82**;Dec 30, 1994;Build 3
GAFHX(YSDATA,YS) ;
N YSBEG,YSEND,YSLIMIT
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 HXLP
Q
PARSE(YS) ; -- array parsing
N X,Y,%DT
S DFN=$G(YS("DFN"),0)
S YSBEG=$G(YS("BEGIN"),"01/01/1970") S X=YSBEG D ^%DT S YSBEG=Y
S YSEND=$G(YS("END"),"01/01/2500") S X=YSEND D ^%DT S YSEND=Y
S YSLIMIT=$G(YS("LIMIT"),9999)
Q
HXLP ;
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=Y_U_$$FMTE^XLFDT(Y,"5TZ")_"^GAF^GAF^"_YSX
.. S YSX=YSX_U_YSN_U_$$EXTERNAL^DILFD(627.8,.04,"",$P($G(^YSD(627.8,YSN,0)),U,4)) ;ASF 2/7/02
.. S YSX=YSX_U_$G(^YSD(627.8,YSN,80,1,0))
.. D SET(YSX)
Q
SET(X) ;
S N=N+1
S YSDATA(N)=X
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HYSGAFAPI 1063 printed Dec 13, 2024@02:14:34 Page 2
YSGAFAPI ;ALB/ASF- GAF API ;2/7/02 15:57
+1 ;;5.01;MENTAL HEALTH;**53,71,82**;Dec 30, 1994;Build 3
GAFHX(YSDATA,YS) ;
+1 NEW YSBEG,YSEND,YSLIMIT
+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 HXLP
+8 QUIT
PARSE(YS) ; -- array parsing
+1 NEW X,Y,%DT
+2 SET DFN=$GET(YS("DFN"),0)
+3 SET YSBEG=$GET(YS("BEGIN"),"01/01/1970")
SET X=YSBEG
DO ^%DT
SET YSBEG=Y
+4 SET YSEND=$GET(YS("END"),"01/01/2500")
SET X=YSEND
DO ^%DT
SET YSEND=Y
+5 SET YSLIMIT=$GET(YS("LIMIT"),9999)
+6 QUIT
HXLP ;
+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=Y_U_$$FMTE^XLFDT(Y,"5TZ")_"^GAF^GAF^"_YSX
+8 ;ASF 2/7/02
SET YSX=YSX_U_YSN_U_$$EXTERNAL^DILFD(627.8,.04,"",$PIECE($GET(^YSD(627.8,YSN,0)),U,4))
+9 SET YSX=YSX_U_$GET(^YSD(627.8,YSN,80,1,0))
+10 DO SET(YSX)
End DoDot:2
End DoDot:1
+11 QUIT
SET(X) ;
+1 SET N=N+1
+2 SET YSDATA(N)=X
+3 QUIT
