- 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 Feb 18, 2025@23:06:43 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
