GMTSDA ; SLC/DLT,KER/NDBI - Appointments ; 5/21/07 11:12am
;;2.7;Health Summary;**5,19,28,49,70,80**;Oct 20, 1995;Build 9
;
; External Reference
; DBIA 1024 ^DIC(40.7
; DBIA 10040 ^SC(
; DBIA 2065 ^SCE(
; DBIA 2065 ^SCE("ADFN"
; DBIA 2929 CVP^A7RHSM
; DBIA 10061 SDA^VADPT
;
PAST ; Gets Patient's Past Appointments for date range
N GMDT,GMIDT,MAX S X=1
S VASD("F")=$S(GMTSBEG=1:2560101,1:GMTSBEG),VASD("T")=$S(GMTS1=6666666:DT,1:9999999-GMTS1)
S MAX=$S(+($G(GMTSNDM))>0:+($G(GMTSNDM)),1:99999)
S VASD("W")=123456789 D SDA^VADPT
I VAERR=1 D CKP^GMTSUP W "RSA ERROR",! D END Q
I VAERR=2 D CKP^GMTSUP W "DATABASE NOT AVAILABLE",! D END Q
S (YCNT,Y)=0 F S Y=$O(^UTILITY("VASD",$J,Y)) Q:'Y S YCNT=YCNT+1,ADATE=$P(^(Y,"I"),U,1),^UTILITY("GMTSVASD",$J,9999999-ADATE)=ADATE_U_$P(^UTILITY("VASD",$J,Y,"E"),U,2,99)
S GMDT=VASD("F")
F S GMDT=$O(^SCE("ADFN",DFN,GMDT)) Q:GMDT'>0!(GMDT>VASD("T")) D
. S GMI=0 F S GMI=$O(^SCE("ADFN",DFN,GMDT,GMI)) Q:GMI'>0 D
. . S GMIDT=9999999-GMDT
. . I '$D(^UTILITY("GMTSVASD",$J,GMIDT)) D
. . . Q:$P($G(^SCE(GMI,0)),U,6)'=""
. . . I $P($G(^SCE(GMI,0)),U,4) Q:$P($G(^SC($P(^SCE(GMI,0),U,4),"OOS")),U)
. . . S ^UTILITY("GMTSVASD",$J,GMIDT)=GMDT_U_$S(+$P(^SCE(GMI,0),U,4):$P($G(^SC(+$P(^(0),U,4),0)),U),1:$P($G(^DIC(40.7,$P(^SCE(GMI,0),U,3),0)),U))_U_"UNSCHEDULED"
D:$$ROK^GMTSU("A7RHSM")&($$NDBI^GMTSU) CVP^A7RHSM
I '$D(^UTILITY("GMTSVASD",$J)) D END Q
S IDATE="",YCNT=0
F S IDATE=$O(^UTILITY("GMTSVASD",$J,IDATE)) Q:+IDATE'>0!(YCNT=MAX) D
. S ADATE=+^(IDATE),ADATE(0)=^(IDATE) D PRINT S YCNT=YCNT+1
D END Q
FUTURE ; Gets Patient's Future Appointments
D SDA^VADPT N MAX S MAX=$S(+($G(GMTSNDM))>0:+($G(GMTSNDM)),1:99999)
I VAERR=2 D CKP^GMTSUP W "DATABASE NOT AVAILABLE",! D END Q
S (YCNT,Y)=0 F S Y=$O(^UTILITY("VASD",$J,Y)) Q:'Y S YCNT=YCNT+1,ADATE=$P(^(Y,"I"),U,1),ADATE(0)=^UTILITY("VASD",$J,Y,"E") D PRINT Q:YCNT=MAX
D END Q
PRINT ; Output
D CKP^GMTSUP Q:$D(GMTSQIT) S X=ADATE D REGDTM4^GMTSU,CKP^GMTSUP
W X,?18,$E($P(ADATE(0),"^",2),1,25),?58,$E($P(ADATE(0),"^",3),1,21)
W ! Q
END ; Clean-up and Quit
K %I,IDATE,IDATES,ADATE,VASD,X,Y,YCNT,Z,^UTILITY("VASD",$J),^UTILITY("GMTSVASD",$J) Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMTSDA 2265 printed Sep 23, 2025@19:33:15 Page 2
GMTSDA ; SLC/DLT,KER/NDBI - Appointments ; 5/21/07 11:12am
+1 ;;2.7;Health Summary;**5,19,28,49,70,80**;Oct 20, 1995;Build 9
+2 ;
+3 ; External Reference
+4 ; DBIA 1024 ^DIC(40.7
+5 ; DBIA 10040 ^SC(
+6 ; DBIA 2065 ^SCE(
+7 ; DBIA 2065 ^SCE("ADFN"
+8 ; DBIA 2929 CVP^A7RHSM
+9 ; DBIA 10061 SDA^VADPT
+10 ;
PAST ; Gets Patient's Past Appointments for date range
+1 NEW GMDT,GMIDT,MAX
SET X=1
+2 SET VASD("F")=$SELECT(GMTSBEG=1:2560101,1:GMTSBEG)
SET VASD("T")=$SELECT(GMTS1=6666666:DT,1:9999999-GMTS1)
+3 SET MAX=$SELECT(+($GET(GMTSNDM))>0:+($GET(GMTSNDM)),1:99999)
+4 SET VASD("W")=123456789
DO SDA^VADPT
+5 IF VAERR=1
DO CKP^GMTSUP
WRITE "RSA ERROR",!
DO END
QUIT
+6 IF VAERR=2
DO CKP^GMTSUP
WRITE "DATABASE NOT AVAILABLE",!
DO END
QUIT
+7 SET (YCNT,Y)=0
FOR
SET Y=$ORDER(^UTILITY("VASD",$JOB,Y))
if 'Y
QUIT
SET YCNT=YCNT+1
SET ADATE=$PIECE(^(Y,"I"),U,1)
SET ^UTILITY("GMTSVASD",$JOB,9999999-ADATE)=ADATE_U_$PIECE(^UTILITY("VASD",$JOB,Y,"E"),U,2,99)
+8 SET GMDT=VASD("F")
+9 FOR
SET GMDT=$ORDER(^SCE("ADFN",DFN,GMDT))
if GMDT'>0!(GMDT>VASD("T"))
QUIT
Begin DoDot:1
+10 SET GMI=0
FOR
SET GMI=$ORDER(^SCE("ADFN",DFN,GMDT,GMI))
if GMI'>0
QUIT
Begin DoDot:2
+11 SET GMIDT=9999999-GMDT
+12 IF '$DATA(^UTILITY("GMTSVASD",$JOB,GMIDT))
Begin DoDot:3
+13 if $PIECE($GET(^SCE(GMI,0)),U,6)'=""
QUIT
+14 IF $PIECE($GET(^SCE(GMI,0)),U,4)
if $PIECE($GET(^SC($PIECE(^SCE(GMI,0),U,4),"OOS")),U)
QUIT
+15 SET ^UTILITY("GMTSVASD",$JOB,GMIDT)=GMDT_U_$SELECT(+$PIECE(^SCE(GMI,0),U,4):$PIECE($GET(^SC(+$PIECE(^(0),U,4),0)),U),1:$PIECE($GET(^DIC(40.7,$PIECE(^SCE(GMI,0),U,3),0)),U))_U_"UNSCHEDULED"
End DoDot:3
End DoDot:2
End DoDot:1
+16 if $$ROK^GMTSU("A7RHSM")&($$NDBI^GMTSU)
DO CVP^A7RHSM
+17 IF '$DATA(^UTILITY("GMTSVASD",$JOB))
DO END
QUIT
+18 SET IDATE=""
SET YCNT=0
+19 FOR
SET IDATE=$ORDER(^UTILITY("GMTSVASD",$JOB,IDATE))
if +IDATE'>0!(YCNT=MAX)
QUIT
Begin DoDot:1
+20 SET ADATE=+^(IDATE)
SET ADATE(0)=^(IDATE)
DO PRINT
SET YCNT=YCNT+1
End DoDot:1
+21 DO END
QUIT
FUTURE ; Gets Patient's Future Appointments
+1 DO SDA^VADPT
NEW MAX
SET MAX=$SELECT(+($GET(GMTSNDM))>0:+($GET(GMTSNDM)),1:99999)
+2 IF VAERR=2
DO CKP^GMTSUP
WRITE "DATABASE NOT AVAILABLE",!
DO END
QUIT
+3 SET (YCNT,Y)=0
FOR
SET Y=$ORDER(^UTILITY("VASD",$JOB,Y))
if 'Y
QUIT
SET YCNT=YCNT+1
SET ADATE=$PIECE(^(Y,"I"),U,1)
SET ADATE(0)=^UTILITY("VASD",$JOB,Y,"E")
DO PRINT
if YCNT=MAX
QUIT
+4 DO END
QUIT
PRINT ; Output
+1 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
SET X=ADATE
DO REGDTM4^GMTSU
DO CKP^GMTSUP
+2 WRITE X,?18,$EXTRACT($PIECE(ADATE(0),"^",2),1,25),?58,$EXTRACT($PIECE(ADATE(0),"^",3),1,21)
+3 WRITE !
QUIT
END ; Clean-up and Quit
+1 KILL %I,IDATE,IDATES,ADATE,VASD,X,Y,YCNT,Z,^UTILITY("VASD",$JOB),^UTILITY("GMTSVASD",$JOB)
QUIT
