SDPPAPP1.m

SDPPAPP1 ;ALB/CAW - Display Appointments; 5/4/92

 ;;5.3;Scheduling;**6,22,140,80,517,1015**;Aug 13, 1993;Build 21

 ;

 ;

EN1 ; Loop through appt. date/time

 N SDAP,SDCI,SDOB,SDPDATA,SDPOV,SDPV,SDWHEN,SDSTART,SDSTOP

 S SDFST=13,SDSEC=55,SDLEN=25,$P(SDASH,"-",IOM+1)="",SDSTART=$S($D(SDBEG):SDBEG,'SDBD:SDBD,1:SDBD-.1),SDSTOP=$S($D(SDEND):SDEND,1:SDED)

 F SDDT=SDSTART:0 S SDDT=$O(^DPT(DFN,"S",SDDT)) Q:'SDDT!(SDDT>(SDSTOP+.9))  D

 .S SDPDATA=^(SDDT,0)

 .I $D(SDY),SDY'=+SDPDATA Q

 .S ^TMP("SDAPT",$J,-SDDT,0)=SDPDATA

 .I $D(^DPT(DFN,"S",SDDT,"R")) S ^TMP("SDAPT",$J,-SDDT,"R")=^DPT(DFN,"S",SDDT,"R")

 .S POP=0 F SDAP=0:0 S SDAP=$O(^SC(+SDPDATA,"S",SDDT,1,SDAP)) Q:'SDAP  D CHK Q:POP  S SDCDATA=$G(^SC(+SDPDATA,"S",SDDT,1,SDAP,0)),SDCI=$G(^("C")),SDOB=$G(^("OB")) I +SDCDATA=DFN S ^TMP("SDAPT",$J,-SDDT,1)=SDCDATA,^("C")=SDCI  ;SD/517 added CHK

 .I '$D(SDCDATA) S (SDCDATA,SDCI,SDOB)=0 S ^TMP("SDAPT",$J,-SDDT,1)=SDCDATA,^("C")=SDCI

 .K SDCDATA

 F I=-9999999.99:0 S I=$O(^TMP("SDAPT",$J,I)) Q:'I  S SDWHEN=$E(I,2,999),SDPDATA=^(I,0),SDCDATA=$G(^(1)),SDCI=$G(^("C")),SDREMARK=$G(^("R")) D INFO

 K ^TMP("SDAPT",$J),POP

 Q

 ;

CHK ;SD/517

 Q:$D(^SC(+SDPDATA,"S",SDDT,1,SDAP,0))

 S SDCDATA=DFN_U_0

 S ^TMP("SDAPT",$J,-SDDT,1)=SDCDATA

 S POP=1

 Q

 ;

INFO ; Set information

 ;

DATE ; Date/Time and Type

 S X="",X=$$SETSTR^VALM1("Date/Time:",X,2,10)

 S X=$$SETSTR^VALM1($TR($$FMTE^XLFDT(SDWHEN,"5F")," ","0"),X,SDFST,SDLEN)

 S X=$$SETSTR^VALM1("Type:",X,49,5)

 S X=$$SETSTR^VALM1($P($G(^SD(409.1,+$P(SDPDATA,U,16),0)),U),X,SDSEC,SDLEN)

 D SET(X)

CLINIC ; Clinic and Eligibility of Visit

 S X="",X=$$SETSTR^VALM1("Clinic:",X,5,7)

 S X=$$SETSTR^VALM1($P($G(^SC(+SDPDATA,0)),U),X,SDFST,SDLEN)

 I $P(SDCDATA,U,10)'="" D

 .S X=$$SETSTR^VALM1("Elig. of Vst.:",X,40,14)

 .S X=$$SETSTR^VALM1($P($G(^DIC(8,+$P(SDCDATA,U,10),0)),U),X,SDSEC,SDLEN)

 D SET(X)

STAT ; Status and Clerk

 S X="",X=$$SETSTR^VALM1("Status:",X,5,7)

 S X=$$SETSTR^VALM1($P($$STATUS^SDAM1(DFN,SDWHEN,+SDPDATA,SDPDATA),";",3),X,SDFST,SDLEN)

 S X=$$SETSTR^VALM1("Clerk:",X,48,6)

 S X=$$SETSTR^VALM1($P($G(^VA(200,$S($P(SDCDATA,U,6):$P(SDCDATA,U,6),1:+$P(SDPDATA,U,18)),0)),U),X,SDSEC,SDLEN)

 D SET(X)

PURP ; Purpose of Visit and Date Appt. Made

 S X="",X=$$SETSTR^VALM1("POV:",X,8,4)

 S SDPOV=$P(SDPDATA,U,7),SDPV=$S(SDPOV=1:"C&P",SDPOV=2:"10-10",SDPOV=3:"SCHEDULED",SDPOV=4:"UNSCHEDULED",1:"UNKNOWN")

 S X=$$SETSTR^VALM1(SDPV,X,SDFST,SDLEN)

 S X=$$SETSTR^VALM1("Date Made:",X,44,10)

 S X=$$SETSTR^VALM1($TR($$FMTE^XLFDT($S($P(SDCDATA,U,7):$P(SDCDATA,U,7),1:$P(SDPDATA,U,19)),"5DF")," ","0"),X,SDSEC,SDLEN)

 D SET(X)

CI ; Checked-In and Checked-Out Times

 S X=""

 I +SDCI D

 .S X=$$SETSTR^VALM1("Checked-In:",X,1,11)

 .S X=$$SETSTR^VALM1($$FMTE^XLFDT($P(SDCI,U),"5"),X,SDFST,SDLEN)

 I $P(SDCI,U,3)'="" D

 .S X=$$SETSTR^VALM1("Checked-Out:",X,42,12)

 .S X=$$SETSTR^VALM1($TR($$FMTE^XLFDT($P(SDCI,U,3),"5F")," ","0"),X,SDSEC,SDLEN)

 ;following logic for Warning added per SD/517

 I $D(SDCDATA) I $P(SDCDATA,U,2)=0 D

 .S X="" D SET(X)

 .D SET("**************************** WARNING *******************************************")

 .D SET("There is a data inconsistency or data corruption problem with the above")

 .D SET("appointment.  Corrective action needs to be taken.  Please cancel")

 .D SET("the appointment above.  If it is a valid appointment, it will have to")

 .D SET("be re-entered via Appointment Management.")

 .D SET("********************************************************************************")

 .S X="" D SET(X)

 ;

 D:X'="" SET(X)

 D ^SDPPAPP2

 Q

SET(X) ; Set in ^TMP global for display

 ;

 S SDLN=SDLN+1,^TMP("SDPPALL",$J,SDLN,0)=X

 S VALMCNT=SDLN

 Q

SDPPAPP1  ;ALB/CAW - Display Appointments; 5/4/92

 +1       ;;5.3;Scheduling;**6,22,140,80,517,1015**;Aug 13, 1993;Build 21

 +2       ;

 +3       ;

EN1       ; Loop through appt. date/time

 +1        NEW SDAP,SDCI,SDOB,SDPDATA,SDPOV,SDPV,SDWHEN,SDSTART,SDSTOP

 +2        SET SDFST=13

           SET SDSEC=55

           SET SDLEN=25

           SET $PIECE(SDASH,"-",IOM+1)=""

           SET SDSTART=$SELECT($DATA(SDBEG):SDBEG,'SDBD:SDBD,1:SDBD-.1)

           SET SDSTOP=$SELECT($DATA(SDEND):SDEND,1:SDED)

 +3        FOR SDDT=SDSTART:0

               SET SDDT=$ORDER(^DPT(DFN,"S",SDDT))

               IF 'SDDT!(SDDT>(SDSTOP+.9))

                   QUIT 

               Begin DoDot:1

 +4                SET SDPDATA=^(SDDT,0)

 +5                IF $DATA(SDY)

                       IF SDY'=+SDPDATA

                           QUIT 

 +6                SET ^TMP("SDAPT",$JOB,-SDDT,0)=SDPDATA

 +7                IF $DATA(^DPT(DFN,"S",SDDT,"R"))

                       SET ^TMP("SDAPT",$JOB,-SDDT,"R")=^DPT(DFN,"S",SDDT,"R")

 +8       ;SD/517 added CHK

                   SET POP=0

                   FOR SDAP=0:0

                       SET SDAP=$ORDER(^SC(+SDPDATA,"S",SDDT,1,SDAP))

                       IF 'SDAP

                           QUIT 

                       DO CHK

                       IF POP

                           QUIT 

                       SET SDCDATA=$GET(^SC(+SDPDATA,"S",SDDT,1,SDAP,0))

                       SET SDCI=$GET(^("C"))

                       SET SDOB=$GET(^("OB"))

                       IF +SDCDATA=DFN

                           SET ^TMP("SDAPT",$JOB,-SDDT,1)=SDCDATA

                           SET ^("C")=SDCI

 +9                IF '$DATA(SDCDATA)

                       SET (SDCDATA,SDCI,SDOB)=0

                       SET ^TMP("SDAPT",$JOB,-SDDT,1)=SDCDATA

                       SET ^("C")=SDCI

 +10               KILL SDCDATA

               End DoDot:1

 +11       FOR I=-9999999.99:0

               SET I=$ORDER(^TMP("SDAPT",$JOB,I))

               IF 'I

                   QUIT 

               SET SDWHEN=$EXTRACT(I,2,999)

               SET SDPDATA=^(I,0)

               SET SDCDATA=$GET(^(1))

               SET SDCI=$GET(^("C"))

               SET SDREMARK=$GET(^("R"))

               DO INFO

 +12       KILL ^TMP("SDAPT",$JOB),POP

 +13       QUIT 

 +14      ;

CHK       ;SD/517

 +1        IF $DATA(^SC(+SDPDATA,"S",SDDT,1,SDAP,0))

               QUIT 

 +2        SET SDCDATA=DFN_U_0

 +3        SET ^TMP("SDAPT",$JOB,-SDDT,1)=SDCDATA

 +4        SET POP=1

 +5        QUIT 

 +6       ;

INFO      ; Set information

 +1       ;

DATE      ; Date/Time and Type

 +1        SET X=""

           SET X=$$SETSTR^VALM1("Date/Time:",X,2,10)

 +2        SET X=$$SETSTR^VALM1($TRANSLATE($$FMTE^XLFDT(SDWHEN,"5F")," ","0"),X,SDFST,SDLEN)

 +3        SET X=$$SETSTR^VALM1("Type:",X,49,5)

 +4        SET X=$$SETSTR^VALM1($PIECE($GET(^SD(409.1,+$PIECE(SDPDATA,U,16),0)),U),X,SDSEC,SDLEN)

 +5        DO SET(X)

CLINIC    ; Clinic and Eligibility of Visit

 +1        SET X=""

           SET X=$$SETSTR^VALM1("Clinic:",X,5,7)

 +2        SET X=$$SETSTR^VALM1($PIECE($GET(^SC(+SDPDATA,0)),U),X,SDFST,SDLEN)

 +3        IF $PIECE(SDCDATA,U,10)'=""

               Begin DoDot:1

 +4                SET X=$$SETSTR^VALM1("Elig. of Vst.:",X,40,14)

 +5                SET X=$$SETSTR^VALM1($PIECE($GET(^DIC(8,+$PIECE(SDCDATA,U,10),0)),U),X,SDSEC,SDLEN)

               End DoDot:1

 +6        DO SET(X)

STAT      ; Status and Clerk

 +1        SET X=""

           SET X=$$SETSTR^VALM1("Status:",X,5,7)

 +2        SET X=$$SETSTR^VALM1($PIECE($$STATUS^SDAM1(DFN,SDWHEN,+SDPDATA,SDPDATA),";",3),X,SDFST,SDLEN)

 +3        SET X=$$SETSTR^VALM1("Clerk:",X,48,6)

 +4        SET X=$$SETSTR^VALM1($PIECE($GET(^VA(200,$SELECT($PIECE(SDCDATA,U,6):$PIECE(SDCDATA,U,6),1:+$PIECE(SDPDATA,U,18)),0)),U),X,SDSEC,SDLEN)

 +5        DO SET(X)

PURP      ; Purpose of Visit and Date Appt. Made

 +1        SET X=""

           SET X=$$SETSTR^VALM1("POV:",X,8,4)

 +2        SET SDPOV=$PIECE(SDPDATA,U,7)

           SET SDPV=$SELECT(SDPOV=1:"C&P",SDPOV=2:"10-10",SDPOV=3:"SCHEDULED",SDPOV=4:"UNSCHEDULED",1:"UNKNOWN")

 +3        SET X=$$SETSTR^VALM1(SDPV,X,SDFST,SDLEN)

 +4        SET X=$$SETSTR^VALM1("Date Made:",X,44,10)

 +5        SET X=$$SETSTR^VALM1($TRANSLATE($$FMTE^XLFDT($SELECT($PIECE(SDCDATA,U,7):$PIECE(SDCDATA,U,7),1:$PIECE(SDPDATA,U,19)),"5DF")," ","0"),X,SDSEC,SDLEN)

 +6        DO SET(X)

CI        ; Checked-In and Checked-Out Times

 +1        SET X=""

 +2        IF +SDCI

               Begin DoDot:1

 +3                SET X=$$SETSTR^VALM1("Checked-In:",X,1,11)

 +4                SET X=$$SETSTR^VALM1($$FMTE^XLFDT($PIECE(SDCI,U),"5"),X,SDFST,SDLEN)

               End DoDot:1

 +5        IF $PIECE(SDCI,U,3)'=""

               Begin DoDot:1

 +6                SET X=$$SETSTR^VALM1("Checked-Out:",X,42,12)

 +7                SET X=$$SETSTR^VALM1($TRANSLATE($$FMTE^XLFDT($PIECE(SDCI,U,3),"5F")," ","0"),X,SDSEC,SDLEN)

               End DoDot:1

 +8       ;following logic for Warning added per SD/517

 +9        IF $DATA(SDCDATA)

               IF $PIECE(SDCDATA,U,2)=0

                   Begin DoDot:1

 +10                   SET X=""

                       DO SET(X)

 +11                   DO SET("**************************** WARNING *******************************************")

 +12                   DO SET("There is a data inconsistency or data corruption problem with the above")

 +13                   DO SET("appointment.  Corrective action needs to be taken.  Please cancel")

 +14                   DO SET("the appointment above.  If it is a valid appointment, it will have to")

 +15                   DO SET("be re-entered via Appointment Management.")

 +16                   DO SET("********************************************************************************")

 +17                   SET X=""

                       DO SET(X)

                   End DoDot:1

 +18      ;

 +19       IF X'=""

               DO SET(X)

 +20       DO ^SDPPAPP2

 +21       QUIT 

SET(X)    ; Set in ^TMP global for display

 +1       ;

 +2        SET SDLN=SDLN+1

           SET ^TMP("SDPPALL",$JOB,SDLN,0)=X

 +3        SET VALMCNT=SDLN

 +4        QUIT