- DGPMV1 ;ALB/MRL/MIR/JAN - PATIENT MOVEMENT, CONT.; 11 APR 89 ; 6/14/01 11:51am
- ;;5.3;Registration;**59,358**;Aug 13, 1993
- K VAIP S VAIP("D")="L",VAIP("L")="" D INP^DGPMV10,Q^VADPT3
- G:'$D(DFN)#2 Q
- 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 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
- I X]"","^C^M^Q^"[("^"_X_"^") D:X'="Q" @X G Q
- W !!,"CHOOSE FROM:" F I=1:1 S J=$P($T(HELP+I),";;",2,999) Q:J="QUIT" W !?5,J
- W ! G NEXT
- ;
- C S DGPM2X=0 ;were DGPMVI variables set 2 times?
- 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
- 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
- .W !!," ** This patient's inpatient or lodger activity is being **",!," ** edited by another employee. Please try again later. **",!
- D ^DGPMV2 L -^DGPM("C",DFN) Q ;continue with movement entry
- Q D KVAR^VADPT K DGPM2X,DGPMIFN,DGPMDCD,DGPMVI,DGPMY,DIE,DR,I,J,X,X1,Z Q
- 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[HDGPMV1 2658 printed Feb 19, 2025@00:16:09 Page 2
- DGPMV1 ;ALB/MRL/MIR/JAN - PATIENT MOVEMENT, CONT.; 11 APR 89 ; 6/14/01 11:51am
- +1 ;;5.3;Registration;**59,358**;Aug 13, 1993
- +2 KILL VAIP
- SET VAIP("D")="L"
- SET VAIP("L")=""
- DO INP^DGPMV10
- DO Q^VADPT3
- +3 if '$DATA(DFN)#2
- GOTO Q
- +4 SET X=$PIECE($GET(^DPT(DFN,0)),"^",14)
- if 'X
- WRITE !!,"Means Test not required based on available information"
- IF X
- Begin DoDot:1
- +5 DO DOM^DGMTR
- if '$GET(DGDOM)
- DO DIS^DGMTU(DFN)
- KILL DGDOM
- End DoDot:1
- +6 DO CS^DGPMV10
- +7 ;
- NEXT SET Z="^CONTINUE^EDIT^MORE^QUIT^"
- WRITE !!,"<C>ontinue, <M>ore, or <Q>uit? CONTINUE// "
- READ X:DTIME
- if '$TEST
- SET X="^"
- IF X']""
- SET X="C"
- WRITE X
- +1 IF X["^"
- SET X="Q"
- WRITE " ",X
- +2 DO IN^DGHELP
- +3 IF X]""
- IF "^C^M^Q^"[("^"_X_"^")
- if X'="Q"
- DO @X
- GOTO Q
- +4 WRITE !!,"CHOOSE FROM:"
- FOR I=1:1
- SET J=$PIECE($TEXT(HELP+I),";;",2,999)
- if J="QUIT"
- QUIT
- WRITE !?5,J
- +5 WRITE !
- GOTO NEXT
- +6 ;
- C ;were DGPMVI variables set 2 times?
- SET DGPM2X=0
- +1 IF DGPMT=1
- IF +DGPMVI(2)=4
- IF '$DATA(^DGPM("APTT1",DFN))
- WRITE !!,*7,"THIS PATIENT IS A LODGER AND HAS NO ADMISSIONS ON FILE.",!,"YOU MUST CHECK HIM OUT PRIOR TO CONTINUING"
- QUIT
- +2 IF DGPMT=4
- IF "^1^2^6^7^"[("^"_+DGPMVI(2)_"^")
- IF '$DATA(^DGPM("APTT4",DFN))
- WRITE !!,*7,"THIS PATIENT IS AN INPATIENT AND HAS NO LODGER MOVEMENTS ON FILE.",!,"YOU MUST DISCHARGE HIM PRIOR TO CONTINUING"
- QUIT
- +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 LOCK +^DGPM("C",DFN):0
- IF '$TEST
- Begin DoDot:1
- +1 WRITE !!," ** This patient's inpatient or lodger activity is being **",!," ** edited by another employee. Please try again later. **",!
- End DoDot:1
- QUIT
- +2 ;continue with movement entry
- DO ^DGPMV2
- LOCK -^DGPM("C",DFN)
- QUIT
- Q DO KVAR^VADPT
- KILL DGPM2X,DGPMIFN,DGPMDCD,DGPMVI,DGPMY,DIE,DR,I,J,X,X1,Z
- QUIT
- 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