DVBAB1B ;ALB/SPH - CAPRI UTILITIES ; 8/21/18 9:58am
;;2.7;AMIE;**104,143,193**;Apr 10, 1995;Build 84
;
DPA(LIST,DFN,CHOICE) ;Display Patient Appointments
N DVBABCNT,CKCHOICE
S LIST="",DVBABCNT=1,CKCHOICE="A,F,P",DFN=$G(DFN),CHOICE=$G(CHOICE) K ^TMP("DVBAAPPT",$J)
I DFN="" S ^TMP("DVBAAPPT",$J,DUZ,DVBABCNT)="MISSING PATIENT NAME",LIST=$NA(^TMP("DVBAAPPT",$J,DUZ)) Q
I CHOICE="" S ^TMP("DVBAAPPT",$J,DUZ,DVBABCNT)="MISSING ALL, PAST, OR FUTURE",LIST=$NA(^TMP("DVBAAPPT",$J,DUZ)) Q
I CKCHOICE'[CHOICE S ^TMP("DVBAAPPT",$J,DUZ,DVBABCNT)="INVALID SELECTION",LIST=$NA(^TMP("DVBAAPPT",$J,DUZ)) Q
I CHOICE["A" D
.S SDT=0
.S X="T+730" D ^%DT
.I Y<0 S ^TMP("DVBAAPPT",$J,DUZ,DVBABCNT)="ERROR IN CALCULATING ENDING DATE RANGE",LIST=$NA(^TMP("DVBAAPPT",$J,DUZ))
.S EDT=Y+.9
I CHOICE["F" D
.S X="T+1" D ^%DT
.I Y<0 S ^TMP("DVBAAPPT",$J,DUZ,DVBABCNT)="ERROR IN CALCULATING START DATE RANGE",LIST=$NA(^TMP("DVBAAPPT",$J,DUZ))
.S SDT=Y
.K X,Y
.S X="T+730" D ^%DT
.I Y<0 S ^TMP("DVBAAPPT",$J,DUZ,DVBABCNT)="ERROR IN CALCULATING ENDING DATE RANGE",LIST=$NA(^TMP("DVBAAPPT",$J,DUZ))
.S EDT=Y+.9
I CHOICE["P" D
.S X="T" D ^%DT
.I Y<0 S ^TMP("DVBAAPPT",$J,DUZ,DVBABCNT)="ERROR IN CALCULATING ENDING DATE RANGE",LIST=$NA(^TMP("DVBAAPPT",$J,DUZ))
.S EDT=Y+.9
.K X,Y
.S SDT=0
Q:LIST["ERROR"
I $O(^DPT(DFN,"S",SDT))'>0 S ^TMP("DVBAAPPT",$J,DUZ,DVBABCNT)="NO APPOINTMENTS FOUND FOR YOUR DATE RANGE",LIST=$NA(^TMP("DVBAAPPT",$J,DUZ)) Q
F S SDT=$O(^DPT(DFN,"S",SDT)) Q:'SDT!(SDT>EDT) D
.S CLN=$P(^DPT(DFN,"S",SDT,0),"^") Q:'CLN
.Q:'$D(^SC(CLN,0))
.S CLN=$P(^SC(CLN,0),"^")
.S ZZ=$L(CLN)
.I ZZ<31 D
..F ZZZ=ZZ:1:30 S CLN=CLN_" "
.S Y=SDT X ^DD("DD")
.S ZZ2=$L(Y)
.I ZZ2<21 D
..F ZZZ2=ZZ2:1:20 S Y=Y_" "
.S STATUS=$P(^DPT(DFN,"S",SDT,0),"^",2)
.I STATUS'="" D
..I STATUS="N" S STATUS="NO-SHOW"
..I STATUS="C" S STATUS="CANCELLED BY CLINIC"
..I STATUS="CA" S STATUS="CANCELLED BY CLINIC & AUTO RE-BOOK"
..I STATUS="NA" S STATUS="NO-SHOW & AUTO-REBOOK"
..I STATUS="I" S STATUS="INPATIENT APPOINTMENT"
..I STATUS="PC" S STATUS="CANCELLED BY PATIENT"
..I STATUS="PCA" S STATUS="CANCELLED BY PATIENT & AUTO RE-BOOK"
..I STATUS="NT" S STATUS="NO ACTION TAKEN"
. I $D(^DPT(DFN,"S",SDT,"R")) S REMARK=$P(^DPT(DFN,"S",SDT,"R"),"^",1) ;ADDED
.S ^TMP("DVBAAPPT",$J,DUZ,DVBABCNT)=CLN_" "_Y_" "_STATUS,DVBABCNT=DVBABCNT+1
. I $D(REMARK) S ^TMP("DVBAAPPT",$J,DUZ,DVBABCNT)=" Cancellation Remarks: "_REMARK,DVBABCNT=DVBABCNT+1
. I $D(REMARK) K REMARK
.S LIST=$NA(^TMP("DVBAAPPT",$J,DUZ))
K DFN,X,%DT,CLN,CHOICE,Y,SDT,EDT
Q
;
CHECK(DVBRSLTS,DVBPATCH) ; Checks for KIDS Patch install
; RPC: DVBA CHECK PATCH
; Input: DVBPATCH - Patch Number (i.e. DVBA*2.7*142)
; Output: Returns "1^Patch Is Installed" on success;
; otherwise returns "0^Patch Is Not Installed"
N DVBX
S DVBX=$$PATCH^XPDUTL(DVBPATCH)
S DVBRSLTS=$S(DVBX:"1^Patch Is Installed",1:"0^Patch Is Not Installed")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDVBAB1B 2978 printed Dec 13, 2024@01:40:20 Page 2
DVBAB1B ;ALB/SPH - CAPRI UTILITIES ; 8/21/18 9:58am
+1 ;;2.7;AMIE;**104,143,193**;Apr 10, 1995;Build 84
+2 ;
DPA(LIST,DFN,CHOICE) ;Display Patient Appointments
+1 NEW DVBABCNT,CKCHOICE
+2 SET LIST=""
SET DVBABCNT=1
SET CKCHOICE="A,F,P"
SET DFN=$GET(DFN)
SET CHOICE=$GET(CHOICE)
KILL ^TMP("DVBAAPPT",$JOB)
+3 IF DFN=""
SET ^TMP("DVBAAPPT",$JOB,DUZ,DVBABCNT)="MISSING PATIENT NAME"
SET LIST=$NAME(^TMP("DVBAAPPT",$JOB,DUZ))
QUIT
+4 IF CHOICE=""
SET ^TMP("DVBAAPPT",$JOB,DUZ,DVBABCNT)="MISSING ALL, PAST, OR FUTURE"
SET LIST=$NAME(^TMP("DVBAAPPT",$JOB,DUZ))
QUIT
+5 IF CKCHOICE'[CHOICE
SET ^TMP("DVBAAPPT",$JOB,DUZ,DVBABCNT)="INVALID SELECTION"
SET LIST=$NAME(^TMP("DVBAAPPT",$JOB,DUZ))
QUIT
+6 IF CHOICE["A"
Begin DoDot:1
+7 SET SDT=0
+8 SET X="T+730"
DO ^%DT
+9 IF Y<0
SET ^TMP("DVBAAPPT",$JOB,DUZ,DVBABCNT)="ERROR IN CALCULATING ENDING DATE RANGE"
SET LIST=$NAME(^TMP("DVBAAPPT",$JOB,DUZ))
+10 SET EDT=Y+.9
End DoDot:1
+11 IF CHOICE["F"
Begin DoDot:1
+12 SET X="T+1"
DO ^%DT
+13 IF Y<0
SET ^TMP("DVBAAPPT",$JOB,DUZ,DVBABCNT)="ERROR IN CALCULATING START DATE RANGE"
SET LIST=$NAME(^TMP("DVBAAPPT",$JOB,DUZ))
+14 SET SDT=Y
+15 KILL X,Y
+16 SET X="T+730"
DO ^%DT
+17 IF Y<0
SET ^TMP("DVBAAPPT",$JOB,DUZ,DVBABCNT)="ERROR IN CALCULATING ENDING DATE RANGE"
SET LIST=$NAME(^TMP("DVBAAPPT",$JOB,DUZ))
+18 SET EDT=Y+.9
End DoDot:1
+19 IF CHOICE["P"
Begin DoDot:1
+20 SET X="T"
DO ^%DT
+21 IF Y<0
SET ^TMP("DVBAAPPT",$JOB,DUZ,DVBABCNT)="ERROR IN CALCULATING ENDING DATE RANGE"
SET LIST=$NAME(^TMP("DVBAAPPT",$JOB,DUZ))
+22 SET EDT=Y+.9
+23 KILL X,Y
+24 SET SDT=0
End DoDot:1
+25 if LIST["ERROR"
QUIT
+26 IF $ORDER(^DPT(DFN,"S",SDT))'>0
SET ^TMP("DVBAAPPT",$JOB,DUZ,DVBABCNT)="NO APPOINTMENTS FOUND FOR YOUR DATE RANGE"
SET LIST=$NAME(^TMP("DVBAAPPT",$JOB,DUZ))
QUIT
+27 FOR
SET SDT=$ORDER(^DPT(DFN,"S",SDT))
if 'SDT!(SDT>EDT)
QUIT
Begin DoDot:1
+28 SET CLN=$PIECE(^DPT(DFN,"S",SDT,0),"^")
if 'CLN
QUIT
+29 if '$DATA(^SC(CLN,0))
QUIT
+30 SET CLN=$PIECE(^SC(CLN,0),"^")
+31 SET ZZ=$LENGTH(CLN)
+32 IF ZZ<31
Begin DoDot:2
+33 FOR ZZZ=ZZ:1:30
SET CLN=CLN_" "
End DoDot:2
+34 SET Y=SDT
XECUTE ^DD("DD")
+35 SET ZZ2=$LENGTH(Y)
+36 IF ZZ2<21
Begin DoDot:2
+37 FOR ZZZ2=ZZ2:1:20
SET Y=Y_" "
End DoDot:2
+38 SET STATUS=$PIECE(^DPT(DFN,"S",SDT,0),"^",2)
+39 IF STATUS'=""
Begin DoDot:2
+40 IF STATUS="N"
SET STATUS="NO-SHOW"
+41 IF STATUS="C"
SET STATUS="CANCELLED BY CLINIC"
+42 IF STATUS="CA"
SET STATUS="CANCELLED BY CLINIC & AUTO RE-BOOK"
+43 IF STATUS="NA"
SET STATUS="NO-SHOW & AUTO-REBOOK"
+44 IF STATUS="I"
SET STATUS="INPATIENT APPOINTMENT"
+45 IF STATUS="PC"
SET STATUS="CANCELLED BY PATIENT"
+46 IF STATUS="PCA"
SET STATUS="CANCELLED BY PATIENT & AUTO RE-BOOK"
+47 IF STATUS="NT"
SET STATUS="NO ACTION TAKEN"
End DoDot:2
+48 ;ADDED
IF $DATA(^DPT(DFN,"S",SDT,"R"))
SET REMARK=$PIECE(^DPT(DFN,"S",SDT,"R"),"^",1)
+49 SET ^TMP("DVBAAPPT",$JOB,DUZ,DVBABCNT)=CLN_" "_Y_" "_STATUS
SET DVBABCNT=DVBABCNT+1
+50 IF $DATA(REMARK)
SET ^TMP("DVBAAPPT",$JOB,DUZ,DVBABCNT)=" Cancellation Remarks: "_REMARK
SET DVBABCNT=DVBABCNT+1
+51 IF $DATA(REMARK)
KILL REMARK
+52 SET LIST=$NAME(^TMP("DVBAAPPT",$JOB,DUZ))
End DoDot:1
+53 KILL DFN,X,%DT,CLN,CHOICE,Y,SDT,EDT
+54 QUIT
+55 ;
CHECK(DVBRSLTS,DVBPATCH) ; Checks for KIDS Patch install
+1 ; RPC: DVBA CHECK PATCH
+2 ; Input: DVBPATCH - Patch Number (i.e. DVBA*2.7*142)
+3 ; Output: Returns "1^Patch Is Installed" on success;
+4 ; otherwise returns "0^Patch Is Not Installed"
+5 NEW DVBX
+6 SET DVBX=$$PATCH^XPDUTL(DVBPATCH)
+7 SET DVBRSLTS=$SELECT(DVBX:"1^Patch Is Installed",1:"0^Patch Is Not Installed")
+8 QUIT
