EHMDGPMV1 ;ALB/WTC - EHRM - AUTOMATED PATIENT DISCHARGE TOOL; Mar 18, 2025@13:02:06
;;1.0;ELECTRONIC HEALTH MODERNIZATION;**15**;Apr 19, 2021;Build 14
;
; Cloned from DGPMV1
;
Q ;
;
ENTRY() ;
N EHMRTNCD S EHMRTNCD=0 ; EHM*1*15 WTC 7/25/24
K VAIP S VAIP("D")="L",VAIP("L")="" D INP^DGPMV10,Q^VADPT3
G:'$D(DFN)#2 Q
S EHMRTNCD=1 ; EHM*1*15 WTC 7/25/24
S X=$P($G(^DPT(DFN,0)),"^",14) W:'X !!,"Means Test not required based on available information" I X D
.D DOM^DGMTR D:'$G(DGDOM) DIS^DGMTU(DFN) K DGDOM
D CS^DGPMV10
;
NEXT S X="C",Z="^CONTINUE^EDIT^MORE^QUIT^" ; WTC 7/12/24;S Z="^CONTINUE^EDIT^MORE^QUIT^" W !!,"<C>ontinue, <M>ore, or <Q>uit? CONTINUE// " R X:DTIME S:'$T X="^" I X']"" S X="C" W X
;I X["^" S X="Q" W " ",X
D IN^DGHELP
; DISABLED EHM*1*15 ;I X]"","^C^M^Q^"[("^"_X_"^") D:X'="Q" @X G Q
D @X G Q ; WTC 7/12/24
; DISABLED EHM*1*15 ;W !!,"CHOOSE FROM:" F I=1:1 S J=$P($T(HELP+I),";;",2,999) Q:J="QUIT" W !?5,J
; DISABLED EHM*1*15 ;W ! G NEXT
;
C S DGPM2X=0 ;were DGPMVI variables set 2 times?
; DISABLED EHM*1*15 ;I DGPMT=1,+DGPMVI(2)=4,'$D(^DGPM("APTT1",DFN)) W !!,*7,"THIS PATIENT IS A LODGER AND HAS NO ADMISSIONS ON FILE.",!,"YOU MUST CHECK HIM OUT PRIOR TO CONTINUING" Q
; DISABLED EHM*1*15 ;I DGPMT=4,"^1^2^6^7^"[("^"_+DGPMVI(2)_"^"),'$D(^DGPM("APTT4",DFN)) W !!,*7,"THIS PATIENT IS AN INPATIENT AND HAS NO LODGER MOVEMENTS ON FILE.",!,"YOU MUST DISCHARGE HIM PRIOR TO CONTINUING" Q
I "^1^2^6"[("^"_+DGPMVI(2)_"^")&("^4^5^"[("^"_DGPMT_"^"))!(+DGPMVI(2)=3&(DGPMT=5)) D LODGER^DGPMV10 S DGPM2X=1
I +DGPMVI(2)=4&("^1^2^3^6^"[("^"_DGPMT_"^"))!(+DGPMVI(2)=5&(DGPMT=3)) K VAIP S VAIP("D")="L" D INP^DGPMV10 S DGPM2X=1
;lock added to block 2 ppl from moving same patient at same time; abr
LOCK L +^DGPM("C",DFN):0 I '$T D Q ; EHM*1*15 WTC 7/25/24
.W !!," ** This patient's inpatient or lodger activity is being **",!," ** edited by another employee. Please try again later. **",! S EHMRTNCD=0 ; EHM*1*15 WTC 7/25/24
; DISABLED EHM*1*15 ;D ^DGPMV2 L -^DGPM("C",DFN) Q ;continue with movement entry
D DGPMV2^EHMDGPMV2 L -^DGPM("C",DFN) Q ;continue with movement entry - WTC 7/15/2024
Q D KVAR^VADPT K DGPM2X,DGPMIFN,DGPMDCD,DGPMVI,DGPMY,DIE,DR,I,J,X,X1,Z Q EHMRTNCD ; EHM*1*15 WTC 7/25/24
M D 10^VADPT S X=$O(^UTILITY("VAEN",$J,0)) D EN S X=$O(^UTILITY("VASD",$J,0)) D AP K I,X W ! D C Q ;display enrollments,appointments --> continue
;
L D ENED^DGRP G C
;
EN W !!?2,"Active clinic enrollments:" I 'X W !?5,"PATIENT IS NOT ACTIVELY ENROLLED IN ANY CLINICS" Q
W !?5,$P(^UTILITY("VAEN",$J,X,"E"),"^",1) F I=X:0 S I=$O(^UTILITY("VAEN",$J,I)) Q:'I S X=$P(^(I,"E"),"^",1) W:($X+$L(X))>70 ",",!?5 W:$X>5 ", " W X
Q
AP W !!?2,"Future Clinic Appointments:" I 'X W !?5,"Patient has no future appointments scheduled" Q
W !?5,$P(^UTILITY("VASD",$J,X,"E"),"^",2)_"( "_$P(^("E"),"^",1)_")" F I=X:0 S I=$O(^UTILITY("VASD",$J,I)) Q:'I S X=^(I,"E"),X=$P(X,"^",2)_"( "_$P(X,"^",1)_")" W:$X+$L(X)>78 ",",!?5 W:$X>5 ", " W X
Q
HELP ;
;;<C> = CONTINUE processing without editing or further displays.
;;<M> = Display pending appointments and clinic enrollments.
;;<Q> = QUIT without further displays or editing.
;;QUIT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HEHMDGPMV1 3213 printed Jul 11, 2026@01:48:08 Page 2
EHMDGPMV1 ;ALB/WTC - EHRM - AUTOMATED PATIENT DISCHARGE TOOL; Mar 18, 2025@13:02:06
+1 ;;1.0;ELECTRONIC HEALTH MODERNIZATION;**15**;Apr 19, 2021;Build 14
+2 ;
+3 ; Cloned from DGPMV1
+4 ;
+5 ;
QUIT
+6 ;
ENTRY() ;
+1 ; EHM*1*15 WTC 7/25/24
NEW EHMRTNCD
SET EHMRTNCD=0
+2 KILL VAIP
SET VAIP("D")="L"
SET VAIP("L")=""
DO INP^DGPMV10
DO Q^VADPT3
+3 if '$DATA(DFN)#2
GOTO Q
+4 ; EHM*1*15 WTC 7/25/24
SET EHMRTNCD=1
+5 SET X=$PIECE($GET(^DPT(DFN,0)),"^",14)
if 'X
WRITE !!,"Means Test not required based on available information"
IF X
Begin DoDot:1
+6 DO DOM^DGMTR
if '$GET(DGDOM)
DO DIS^DGMTU(DFN)
KILL DGDOM
End DoDot:1
+7 DO CS^DGPMV10
+8 ;
NEXT ; WTC 7/12/24;S Z="^CONTINUE^EDIT^MORE^QUIT^" W !!,"<C>ontinue, <M>ore, or <Q>uit? CONTINUE// " R X:DTIME S:'$T X="^" I X']"" S X="C" W X
SET X="C"
SET Z="^CONTINUE^EDIT^MORE^QUIT^"
+1 ;I X["^" S X="Q" W " ",X
+2 DO IN^DGHELP
+3 ; DISABLED EHM*1*15 ;I X]"","^C^M^Q^"[("^"_X_"^") D:X'="Q" @X G Q
+4 ; WTC 7/12/24
DO @X
GOTO Q
+5 ; DISABLED EHM*1*15 ;W !!,"CHOOSE FROM:" F I=1:1 S J=$P($T(HELP+I),";;",2,999) Q:J="QUIT" W !?5,J
+6 ; DISABLED EHM*1*15 ;W ! G NEXT
+7 ;
C ;were DGPMVI variables set 2 times?
SET DGPM2X=0
+1 ; DISABLED EHM*1*15 ;I DGPMT=1,+DGPMVI(2)=4,'$D(^DGPM("APTT1",DFN)) W !!,*7,"THIS PATIENT IS A LODGER AND HAS NO ADMISSIONS ON FILE.",!,"YOU MUST CHECK HIM OUT PRIOR TO CONTINUING" Q
+2 ; DISABLED EHM*1*15 ;I DGPMT=4,"^1^2^6^7^"[("^"_+DGPMVI(2)_"^"),'$D(^DGPM("APTT4",DFN)) W !!,*7,"THIS PATIENT IS AN INPATIENT AND HAS NO LODGER MOVEMENTS ON FILE.",!,"YOU MUST DISCHARGE HIM PRIOR TO CONTINUING" Q
+3 IF "^1^2^6"[("^"_+DGPMVI(2)_"^")&("^4^5^"[("^"_DGPMT_"^"))!(+DGPMVI(2)=3&(DGPMT=5))
DO LODGER^DGPMV10
SET DGPM2X=1
+4 IF +DGPMVI(2)=4&("^1^2^3^6^"[("^"_DGPMT_"^"))!(+DGPMVI(2)=5&(DGPMT=3))
KILL VAIP
SET VAIP("D")="L"
DO INP^DGPMV10
SET DGPM2X=1
+5 ;lock added to block 2 ppl from moving same patient at same time; abr
LOCK ; EHM*1*15 WTC 7/25/24
LOCK +^DGPM("C",DFN):0
IF '$TEST
Begin DoDot:1
+1 ; EHM*1*15 WTC 7/25/24
WRITE !!," ** This patient's inpatient or lodger activity is being **",!," ** edited by another employee. Please try again later. **",!
SET EHMRTNCD=0
End DoDot:1
QUIT
+2 ; DISABLED EHM*1*15 ;D ^DGPMV2 L -^DGPM("C",DFN) Q ;continue with movement entry
+3 ;continue with movement entry - WTC 7/15/2024
DO DGPMV2^EHMDGPMV2
LOCK -^DGPM("C",DFN)
QUIT
Q ; EHM*1*15 WTC 7/25/24
DO KVAR^VADPT
KILL DGPM2X,DGPMIFN,DGPMDCD,DGPMVI,DGPMY,DIE,DR,I,J,X,X1,Z
QUIT EHMRTNCD
M ;display enrollments,appointments --> continue
DO 10^VADPT
SET X=$ORDER(^UTILITY("VAEN",$JOB,0))
DO EN
SET X=$ORDER(^UTILITY("VASD",$JOB,0))
DO AP
KILL I,X
WRITE !
DO C
QUIT
+1 ;
L DO ENED^DGRP
GOTO C
+1 ;
EN WRITE !!?2,"Active clinic enrollments:"
IF 'X
WRITE !?5,"PATIENT IS NOT ACTIVELY ENROLLED IN ANY CLINICS"
QUIT
+1 WRITE !?5,$PIECE(^UTILITY("VAEN",$JOB,X,"E"),"^",1)
FOR I=X:0
SET I=$ORDER(^UTILITY("VAEN",$JOB,I))
if 'I
QUIT
SET X=$PIECE(^(I,"E"),"^",1)
if ($X+$LENGTH(X))>70
WRITE ",",!?5
if $X>5
WRITE ", "
WRITE X
+2 QUIT
AP WRITE !!?2,"Future Clinic Appointments:"
IF 'X
WRITE !?5,"Patient has no future appointments scheduled"
QUIT
+1 WRITE !?5,$PIECE(^UTILITY("VASD",$JOB,X,"E"),"^",2)_"( "_$PIECE(^("E"),"^",1)_")"
FOR I=X:0
SET I=$ORDER(^UTILITY("VASD",$JOB,I))
if 'I
QUIT
SET X=^(I,"E")
SET X=$PIECE(X,"^",2)_"( "_$PIECE(X,"^",1)_")"
if $X+$LENGTH(X)>78
WRITE ",",!?5
if $X>5
WRITE ", "
WRITE X
+2 QUIT
HELP ;
+1 ;;<C> = CONTINUE processing without editing or further displays.
+2 ;;<M> = Display pending appointments and clinic enrollments.
+3 ;;<Q> = QUIT without further displays or editing.
+4 ;;QUIT
