DGRP14.m

DGRP14 ;ALB/MRL/EG/GAH - REGISTRATION SCREEN 14/APPOINTMENT INFORMATION ; 10/18/06

 ;;5.3;PIMS;**568,585,725,770,1015,1016**;JUN 30, 2012;Build 20

 S DGRPS=14 D H^DGRPU S (Z,DGRPW)=1 D WW^DGRPV W " Enrollment Clinics: "

 S I1=""

 F I=0:0 S I=$O(^DPT(DFN,"DE",I)) Q:'I  D:$P(^(I,0),U,2)'="I"

 . S I1=1,X=$S($D(^SC(+^(0),0)):$P(^(0),U,1)_", ",1:"")

 . W:(79-$X)<$L(X) !?24 W X

 W:'I1 "NOT ACTIVELY ENROLLED IN ANY CLINICS AT THIS TIME"

 W ! S Z=2 D WW^DGRPV W "     Pending Appt's",?18,": " S I1="",I2=DT_".9999"

 N DGARRAY,APTDT,CLIFN,CLNAM

 S DGARRAY("FLDS")="1;2;3",DGARRAY(3)="R;I;NT",DGARRAY(4)=DFN,DGARRAY(1)=DT,DGARRAY("SORT")="P"

 S I1=$$SDAPI^SDAMA301(.DGARRAY)

 ;Check for appointment retrieval error.

 I I1<0 W $$FAPCHK^DGENRPD2 G Q

 S APTDT=0

 F  S APTDT=$O(^TMP($J,"SDAMA301",DFN,APTDT)) Q:'APTDT  D

 .;check to see if appointment is cancelled, if so

 .;ignore this appointment eg 01/25/2005

 .;I $$CANCEL(DFN,APTDT)="Y" Q TAKEN OUT IN PATCH 770.

 .S CLNAM=$P($P(^TMP($J,"SDAMA301",DFN,APTDT),U,2),";",2)

 .S X=$S(CLNAM]"":CLNAM,1:"UNKNOWN CLINIC")_" ("_$$FMTE^DILIBF(APTDT,"5U")_"), " W:(79-$X)<$L(X) !?24 W X

 .Q

 I 'I1 W "NO PENDING APPOINTMENTS ON FILE"

Q K I,I1,I2,X,Y,DGARRAY,APTDT,CLNAM,^TMP($J,"SDAMA301") G ^DGRPP

 ;

 ;input DFN - patient id

 ;      APPDATE - appointment date

 ;return Y - Yes

 ;       N - No

CANCEL(DFN,APPDATE) ;

 N X,STATUS,U

 S U="^"

 S X=$G(^DPT(DFN,"S",APPDATE,0))

 I X="" Q "Y"  ;probably bad data

 S STATUS=$P(X,U,2)

 I STATUS="" Q "N"

 I STATUS="I" Q "N"

 Q "Y"

DGRP14    ;ALB/MRL/EG/GAH - REGISTRATION SCREEN 14/APPOINTMENT INFORMATION ; 10/18/06

 +1       ;;5.3;PIMS;**568,585,725,770,1015,1016**;JUN 30, 2012;Build 20

 +2        SET DGRPS=14

           DO H^DGRPU

           SET (Z,DGRPW)=1

           DO WW^DGRPV

           WRITE " Enrollment Clinics: "

 +3        SET I1=""

 +4        FOR I=0:0

               SET I=$ORDER(^DPT(DFN,"DE",I))

               IF 'I

                   QUIT 

               IF $PIECE(^(I,0),U,2)'="I"

                   Begin DoDot:1

 +5                    SET I1=1

                       SET X=$SELECT($DATA(^SC(+^(0),0)):$PIECE(^(0),U,1)_", ",1:"")

 +6                    IF (79-$X)<$LENGTH(X)

                           WRITE !?24

                       WRITE X

                   End DoDot:1

 +7        IF 'I1

               WRITE "NOT ACTIVELY ENROLLED IN ANY CLINICS AT THIS TIME"

 +8        WRITE !

           SET Z=2

           DO WW^DGRPV

           WRITE "     Pending Appt's",?18,": "

           SET I1=""

           SET I2=DT_".9999"

 +9        NEW DGARRAY,APTDT,CLIFN,CLNAM

 +10       SET DGARRAY("FLDS")="1;2;3"

           SET DGARRAY(3)="R;I;NT"

           SET DGARRAY(4)=DFN

           SET DGARRAY(1)=DT

           SET DGARRAY("SORT")="P"

 +11       SET I1=$$SDAPI^SDAMA301(.DGARRAY)

 +12      ;Check for appointment retrieval error.

 +13       IF I1<0

               WRITE $$FAPCHK^DGENRPD2

               GOTO Q

 +14       SET APTDT=0

 +15       FOR 

               SET APTDT=$ORDER(^TMP($JOB,"SDAMA301",DFN,APTDT))

               IF 'APTDT

                   QUIT 

               Begin DoDot:1

 +16      ;check to see if appointment is cancelled, if so

 +17      ;ignore this appointment eg 01/25/2005

 +18      ;I $$CANCEL(DFN,APTDT)="Y" Q TAKEN OUT IN PATCH 770.

 +19               SET CLNAM=$PIECE($PIECE(^TMP($JOB,"SDAMA301",DFN,APTDT),U,2),";",2)

 +20               SET X=$SELECT(CLNAM]"":CLNAM,1:"UNKNOWN CLINIC")_" ("_$$FMTE^DILIBF(APTDT,"5U")_"), "

                   IF (79-$X)<$LENGTH(X)

                       WRITE !?24

                   WRITE X

 +21               QUIT 

               End DoDot:1

 +22       IF 'I1

               WRITE "NO PENDING APPOINTMENTS ON FILE"

Q          KILL I,I1,I2,X,Y,DGARRAY,APTDT,CLNAM,^TMP($JOB,"SDAMA301")

           GOTO ^DGRPP

 +1       ;

 +2       ;input DFN - patient id

 +3       ;      APPDATE - appointment date

 +4       ;return Y - Yes

 +5       ;       N - No

CANCEL(DFN,APPDATE) ;

 +1        NEW X,STATUS,U

 +2        SET U="^"

 +3        SET X=$GET(^DPT(DFN,"S",APPDATE,0))

 +4       ;probably bad data

           IF X=""

               QUIT "Y"

 +5        SET STATUS=$PIECE(X,U,2)

 +6        IF STATUS=""

               QUIT "N"

 +7        IF STATUS="I"

               QUIT "N"

 +8        QUIT "Y"