YSGAFAPI.m

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 ---YSGAFAPI   1063     printed  Apr 09, 2024@21:22:35                                                                                                                                                                                                    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