Changeset 623 for WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/VADPT3.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/VADPT3.m
r613 r623 1 VADPT3 2 ;;5.3;Registration;**532,749**;Aug 13, 1993;Build 10 3 4 6 5 S (NOW,VAX("DAT"))=$$NOW^XLFDT,NOWI=9999999.999999-NOW 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 GO 23 24 Q 25 26 OK 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 OK1 42 43 44 45 LAST 46 47 48 49 50 LASTQ 51 52 53 LODGER 54 55 56 57 58 59 LODGERQ 60 61 LLDCHK 62 63 64 65 66 67 68 CHK 69 70 71 ASIHOF 72 73 74 75 76 42 77 78 79 80 81 82 Q42 83 84 SCAN 85 86 87 88 89 90 47 91 92 93 94 95 96 97 1 VADPT3 ;ALB/MRL - PATIENT VARIABLES [IN5]; 12 DEC 1988 ; 7/22/03 5:00pm 2 ;;5.3;Registration;**532**;Aug 13, 1993 3 ;Inpatient variables [Version 5.0 and above] 4 6 ; 5 D NOW^%DTC S (NOW,VAX("DAT"))=%,NOWI=9999999.999999-% 6 ; 7 I $D(VAIP("E")),$D(^DGPM(+VAIP("E"),0)) S VAX("DT")=+^(0),E=+VAIP("E") G GO ;Specific Entry 8 ; 9 I $D(VAIP("D")),"^l^L^"[("^"_$E(VAIP("D"))_"^") D LAST G GO:E,Q 10 ; 11 S VAX=$S($D(VAIP("D")):VAIP("D"),$D(VAINDT):VAINDT,1:0) 12 I VAX S:VAX?7N!(VAX?7N1".".N) VAX("DT")=VAX I '$D(VAX("DT")) G Q ;Invalid Entry 13 ; 14 S:'$D(VAX("DT")) VAX("DT")=NOW 15 I VAX("DT")=VAX("DAT") S E=$S($D(^DPT(DFN,.102)):+^(.102),1:0),E=$S($D(^DGPM(E,0)):E,1:0) G GO:E D LODGER G GO:E D ASIHOF G GO:E,Q ;Current IP 16 ; 17 ;Find Past Movement 18 S VAX=+$O(^DGPM("APID",DFN,9999999.999999-VAX("DT"))) I 'VAX D LODGER G GO:E,Q 19 S VAX=+$O(^DGPM("APID",DFN,VAX,0)) I '$D(^DGPM(VAX,0)) D LODGER G GO:E,Q 20 S VAZ=^DGPM(VAX,0) D OK G GO:E D LODGER G GO:E,Q 21 ; 22 GO S:'$D(VAX("DT")) VAX("DT")=NOW D ^VADPT31 ; setting of VAX("DT") can be removed?? 23 ; 24 Q K NOW,NOWI,VAX,VAZ,VAZ2,E,VACC,VAQ,VANN,VASET,^UTILITY("VADPTZ",$J,DFN) D KVAR^VADPT30 Q 25 ; 26 OK N VAADT,VADDT,VAQUIT 27 S E=0,VAZ2="^"_(+$P(VAZ,"^",18))_"^" 28 I "^13^41^46^"[VAZ2 D OK1 Q:'VAX G OK 29 I "^42^"[VAZ2 D 42 I 'Y D OK1 Q:'VAX G OK 30 I "^47^"[VAZ2 D 47 I 'Y D OK1 Q:'VAX G OK 31 I $D(VAX("DT")),$P(VAZ,"^",2)=3,VAZ'>VAX("DT") Q 32 ;DG*5.3*532 33 ;Check for out-of-order disch. recs caused by same day adm./disch. 34 ;where disch. date < adm. date because disch. date had no time 35 I +VAZ<2890000,$D(VAX("DT")),$P(VAZ,"^",2)'=3 S VAQUIT=0 D Q:VAQUIT 36 .S VAADT=$P(VAZ,"^",14) Q:'VAADT 37 .S VADDT=$P($G(^DGPM(VAADT,0)),"^",17) Q:'VADDT 38 .S VADDT=$P($G(^DGPM(VADDT,0)),"^",14) I $P(VADDT,".",2)="",VADDT=$P(VAADT,"."),VAZ'>VAX("DT") S VAQUIT=1 39 S E=+VAX Q 40 ; 41 OK1 S VAX=+$O(^DGPM("APID",DFN,9999999.9999999-(VAZ+($P(VAZ,"^",22)/10000000)))),VAX=+$O(^(VAX,0)) 42 I VAX,$D(^DGPM(VAX,0)) S VAZ=^(0) 43 Q 44 ; 45 LAST ; returns last movement for patient 46 ; called by bed control and pt inquiry 47 S VAX=+$O(^DGPM("APID",DFN,NOWI)),E=0 48 I $D(VAIP("L")) D LLDCHK G LASTQ:E 49 S VAX=+$O(^DGPM("APID",DFN,VAX,0)) I $D(^DGPM(VAX,0)) S VAZ=^(0) D OK 50 LASTQ S VAX("DT")=NOW 51 Q 52 ; 53 LODGER ; 54 S E=0 G LODGERQ:'$D(VAIP("L")) 55 I VAX("DT")=VAX("DAT") S VAX=$S($D(^DPT(DFN,.107)):^(.107),1:"") G LODGERQ:VAX']"" S E=$S($D(^DPT("LD",VAX,DFN)):+^(DFN),1:0) G LODGERQ 56 ; 57 S VAX=$O(^DGPM("ATID4",DFN,9999999.999999-VAX("DT"))) S:VAX E=+$O(^DGPM("ATID4",DFN,VAX,0)) 58 I E S E=$S($D(^DGPM(E,0)):E,1:0) I E,$D(^DGPM(+$P(^(0),"^",17),0)),^(0)'>VAX("DT") S E=0 59 LODGERQ Q 60 ; 61 LLDCHK ; -- last lodger mvt checking ; build array of inverse dates and chk 62 N IDT S IDT(VAX)=0 63 S IDT=+$O(^DGPM("ATID4",DFN,NOWI)) S:IDT IDT(IDT)=+$O(^(IDT,0)) 64 S IDT=+$O(^DGPM("ATID5",DFN,NOWI)) S:IDT IDT(IDT)=+$O(^(IDT,0)) 65 S IDT=+$O(IDT(0)) I IDT S E=IDT(IDT),E=$S($D(^DGPM(E,0)):E,1:0) 66 Q 67 ; 68 CHK ; 69 G VAR^VADPT30 70 ; 71 ASIHOF ; -- is last mvt asih oth fac 72 S E=0,VAX=$S('$O(^DGPM("APID",DFN,NOWI)):"",1:$O(^DGPM("APID",DFN,$O(^(NOWI)),0))) 73 I VAX,$D(^DGPM(VAX,0)),"^43^45^"[("^"_$P(^(0),"^",18)_"^") S E=VAX 74 Q 75 ; 76 42 ; -- check to see if this mvt can be used; for 'while asih' d/c category 77 ; If Y returned high then mvt is good 78 ; 79 I VAZ'<VAX("DAT") S Y=0 G Q42 ; not a real d/c yet 80 I $P(VAZ,"^",22)=2 S Y=0 G Q42 ; nhcu d/c assoicated w/asih d/c (seq #2) 81 D SCAN 82 Q42 Q 83 ; 84 SCAN ; -- determine is d/c while in other fac(Y=1 returned if so.) 85 ; 86 N VAID,VACA,M S Y=0,VAID=9999999.999999-VAZ,VACA=+$P(VAZ,"^",14) 87 F VAID=VAID:0 S VAID=$O(^DGPM("APMV",DFN,VACA,VAID)) Q:'VAID I $D(^DGPM(+$O(^(VAID,0)),0)) S M=$P(^(0),"^",18) I "^13^44^43^45^"[("^"_M_"^") S Y=$S(M=43!(M=45):1,1:0) Q 88 Q 89 ; 90 47 ; -- check to see if d/c from nhcu while asih in other fac 91 ; If y returned high then mvt is good. 92 D SCAN Q 93 ; 94 ; 13 = to asih (vah) (xfr)|44 = resume asih in parent facility (xfr) 95 ; 41 = from asih (d/c)|45 = change asih location(other fac)(xfr) 96 ; 42 = while asih (d/c)|46 = continues asih (other fac) (d/c) 97 ; 43 = to asih(other fac)(xfr)|47 = discharge from nhcu while asih (d/c)
Note:
See TracChangeset
for help on using the changeset viewer.
