- 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 Feb 18, 2025@23:40:51 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
