DGPMV21 ;ALB/MRL/MIR - PASS/FAIL MOVEMENT DATE; 8 MAY 89 ;;5.3;Registration;**40,95,131**;Aug 13, 1993 I $S('$D(DGPMY):1,DGPMY?7N:0,DGPMY'?7N1".".N:1,1:0) S DGPME="DATE EITHER NOT PASSED OR NOT IN EXPECTED VA FILEMANAGER FORMAT" G Q I $S('$D(DGPMT):1,'DGPMT:1,1:0) S DGPME="TRANSACTION TYPE IS NOT DEFINED" G Q D PTF^DGPMV22(DFN,DGPMDA,.DGPME,DGPMCA) G:$G(DGPME)]"" Q K DGPME G CONT:("^4^5^"[("^"_DGPMT_"^"))!DGPMN D PTF I $D(DGPME),DGPME="***" Q CONT Q:'DGPMN D CHK I $D(DGPME) G Q I DGPM1X Q ;Don't ask to add a new one if discharge or check-out ADD S Y=DGPMY X ^DD("DD") ADD1 W !!,"SURE YOU WANT TO ADD '",Y,"' AS A NEW ",DGPMUC," DATE" S:"^1^4^"'[("^"_DGPMT_"^") %=1 D YN^DICN Q:%=1 I '% W !?4,"Answer YES if you wish to add this new entry otherwise answer NO!" G ADD1 S DGPME="NOTHING ADDED" G Q ; CHK ;Check new date/time for consistency with other movements I $D(^DGPM("APRD",DFN,DGPMY))!$D(^DGPM("APTT6",DFN,DGPMY))!$D(^DGPM("APTT4",DFN,DGPMY))!$D(^DGPM("APTT5",DFN,DGPMY)) S DGPME="There is already a movement at that date/time" Q I "^1^4^"'[("^"_DGPMT_"^"),(DGPMY<+DGPMAN) S DGPME="Not before "_$S(DGPMT<4:"admission",DGPMT>5:"admission",1:"check-in")_" movement" Q I "^3^5^"'[("^"_DGPMT_"^"),DGPMCA I DGPMDCD,(DGPMY>DGPMDCD) S DGPME="Not after "_$S(DGPMT<4:"discharge",DGPMT>5:"discharge",1:"check-out")_" movement" Q I DGPMT=3 S I=$O(^DGPM("APMV",DFN,DGPMCA,0)),I=$O(^(+I,0)) I $D(^DGPM(+I,0)),(+^(0)>DGPMY) S DGPME="Not before last movement" Q I DGPMT=3 S I=$O(^DGPM("ATS",DFN,DGPMCA,0)),I=$O(^(+I,0)),I=$O(^(+I,0)) I $D(^DGPM(+I,0)),(+^(0)>DGPMY) S DGPME="Not before last movement" Q I $D(^DGPM(+$P(DGPMAN,"^",21),0)),$D(^DGPM(+$P(^(0),"^",14),0)),$D(^DGPM(+$P(^(0),"^",17),0)) S X=^(0) I $P(X,"^",18)=47,(DGPMY'>+X) S DGPME="Must be after NHCU/DOM discharge" Q I DGPMT=6,$$CHKLAST^DGPMV30(DFN,DGPMCA,+DGPMY) S DGPME="Cannot change treating specialty while patient is on absence." Q I "^1^4^"'[("^"_DGPMT_"^") Q S X=$O(^DGPM("APTT3",DFN,DGPMY)),Y=$O(^DGPM("APTT5",DFN,DGPMY)) I X!Y S DGPME="New "_$S(DGPMT=1:"admission",1:"check-in")_" ...must enter after last "_$S(X:"discharge",1:"check-out") G Q S DGX=$P(DGPMAN,"^",21) Q:'$D(^DGPM(+DGX,0)) S DGX=^(0),X=$S($D(^DGPM(+$P(DGX,"^",14),0)):^(0),1:"") Q:'X I $D(^DGP(45.84,+$P(X,"^",16))) S DGPME="Can't edit. Corresponding NHCU/DOM PTF Record is Closed." G Q I $D(^DGPM(+$P(DGPMAN,"^",17),0)),+^(0) S DGPME="After discharge. Must edit movement through NHCU/DOM transfer." G Q Q ; ; PTF S PTF=+$P(DGPMAN,"^",16) I $S('PTF:1,'$D(^DGPT(PTF,0)):1,1:0) D NOPTF Q I $D(^DGP(45.84,PTF)) S DGPME="***" W !,"PTF record is closed for this admission...cannot edit" G Q Q ; NOPTF W *7 F I=1:1 S J=$P($T(NP+I),";;",2) Q:J="" W !?4,J S DGPME="***" Q S DGPMY=0 Q ; NP ; ;;WARNING: This admission has no corresponding PTF record. ;;A PTF record is required in order to continue processing ;;this movement activity. If you have the PTF option called ;;"Establish PTF record from Past Admission" on your menu, it ;;may be used to create the PTF record for this admission. ;;Otherwise appropriate Medical Information Section (MIS) ;;personnel and/or your supervisor will need to be notified ;;that the PTF record is missing as soon as possible in order ;;to continue processing this movement.