SDPPAPP1 ;ALB/CAW - Display Appointments; 5/4/92
;;5.3;Scheduling;**6,22,140,80,517**;Aug 13, 1993;Build 4
;
;
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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDPPAPP1 3692 printed Apr 09, 2024@21:42:16 Page 2
SDPPAPP1 ;ALB/CAW - Display Appointments; 5/4/92
+1 ;;5.3;Scheduling;**6,22,140,80,517**;Aug 13, 1993;Build 4
+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
