- 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 Mar 13, 2025@21:01:49 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
