source: WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGPMV22.m@ 1593

Last change on this file since 1593 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 3.4 KB
RevLine 
[613]1DGPMV22 ;ALB/MIR - SCHEDULED ADMISSION? ; 23 NOV 90
2 ;;5.3;Registration;**40**;Aug 13, 1993
3SCHDADM ;is this a scheduled admission...DGPMSA=1 for yes, 0 for no
4 ;must be within 7 days of actual scheduled admission entry
5 S X1=DGPMY,X2=-7 D C^%DTC S DGPMSD=$P(X,".")-.1
6 S X1=DGPMY,X2=7 D C^%DTC S DGPMED=$P(X,".")+.9
7 S DGCT=0 F DGI=0:0 S DGI=$O(^DGS(41.1,"B",DFN,DGI)) Q:'DGI S J=$S($D(^DGS(41.1,DGI,0)):^(0),1:"") I J,($P(J,"^",2)>DGPMSD),($P(J,"^",2)<DGPMED) I '$P(J,"^",13),'$P(J,"^",17) S DGCT=DGCT+1 D WR
8 I 'DGCT S DGPMSA=0 G SCHDQ
9 ;
10ASK W !,"Is this ",$S(DGCT=1:"the",1:"one of the")," scheduled admission",$S(DGCT>1:"s",1:"")," listed above" S %=1 D YN^DICN I %Y["?" W !?5,"Answer yes if this is a scheduled admission, otherwise no." G ASK
11 S DGPMSA=$S(%<0:0,1:'(%-1)) I 'DGPMSA G SCHDQ
12 I DGCT=1 S DGPMSA=^UTILITY("DGPMSA",$J,1) G SCHDQ
13WHICH W !,"Which scheduled admission is it? " R X:DTIME I '$T S DGPMER="" D SCHDQ K DGPMY Q
14 I X["?" W !,"Choose a number 1-",DGCT G WHICH
15 W ! I X["^"!'X!(X<1)!(X>DGCT) G ASK
16 S DGPMSA=^UTILITY("DGPMSA",$J,X)
17SCHDQ K X,X1,X2,DGCT,DGPMED,DGPMSD,^UTILITY("DGPMSA",$J),DGI,J Q
18 ;
19WR S Y=$P(J,"^",2) X ^DD("DD")
20 I DGCT=1 W !!,"Scheduled admissions:"
21 W !?2,DGCT,". ",Y,?25,$S($P(J,"^",10)="W":"WARD: "_$S($D(^DIC(42,+$P(J,"^",8),0)):$P(^(0),"^",1),1:""),$P(J,"^",10)="T":"FACILITY TREATING SPECIALTY: "_$S($D(^DIC(45.7,+$P(J,"^",9),0)):$P(^(0),"^",1),1:""),1:"")
22 S ^UTILITY("DGPMSA",$J,DGCT)=DGI
23 Q
24 ;
25 ;
26PTF(DFN,DGPMDA,DGPME,DGPMCA) ;ptf check
27 ;
28 ; prevent editing of a movement if related to admission w/closed PTF
29 ; (either same admission or ASIH-related admission)
30 ;
31 ; Input: DFN = ien of patient file
32 ; DGPMDA = ien of patient movement file
33 ; DGPME = error flag if ptf closed out <by reference>
34 ; DGPMCA = ien of admission movement from pt mvmnt file
35 ;
36 ; Output: DGPME = "" if no error; otherwise error message
37 ;
38 I $S('+$G(DFN):1,'+$G(DGPMDA):1,'+$G(DGPMCA):1,1:0) Q
39 ;
40 N MVTYPE,NODE,TRANS,X
41 S NODE=$G(^DGPM(DGPMDA,0)),TRANS=$P(NODE,U,2),TYPE=$P(NODE,U,18)
42 ;
43 ; check PTF of current admission for all movements
44 D PTFC($P(NODE,"^",14),.DGPME) I $G(DGPME)]"" G PTFQ
45 ;
46 ; check related nhcu/dom admission if current admission = TO ASIH
47 I TRANS=1 D:$P(NODE,"^",21) G PTFQ
48 . S X=$G(^DGPM($P(NODE,"^",21),0))
49 . D PTFC($P(X,"^",14),.DGPME)
50 ;
51 ; check related ASIH admission if nhcu/dom transfer movement
52 I TRANS=2 D G PTFQ
53 . I "^13^14^44^45^"'[("^"_TYPE_"^") Q ; not ASIH mvt...quit
54 . I "^13^44^"[("^"_TYPE_"^") D PTFC($P(NODE,"^",15),.DGPME) Q ; to asih or resume asih xfr...check hospital PTF & quit
55 . S X=$O(^DGPM("APMV",DFN,DGPMCA,(9999999.9999999-+NODE))),X=$O(^DGPM("APMV",DFN,DGPMCA,+X,0)) ; prior mvt ien
56 . S X=$G(^DGPM(+X,0)) ; prior mvt node
57 . I $P(X,"^",15) D PTFC($P(X,"^",15),.DGPME) ; if prior mvt associated with hospital admission, check hospital ptf
58 ;
59 ; check related nhcu/dom admission if asih discharge
60 I TRANS=3,("^41^46^"[("^"_TYPE_"^")) D
61 . S X=$G(^DGPM(+$P(NODE,"^",14),0)),X=$G(^DGPM(+$P(X,"^",21),0)) ; x=associated nhcu/dom transfer node
62 . I X]"" D PTFC($P(X,"^",14),.DGPME)
63PTFQ Q
64 ;
65 ;
66PTFC(ADMIT,DGPME) ;check if ptf in close out file/ set error flag if true
67 ;
68 ; Input: ADMIT = ien of admission record
69 ; DGPME = ptf closed flag <by reference>
70 ; Output: DGPME = set if ptf closed out
71 ;
72 Q:'+$G(ADMIT)
73 N PTF
74 S PTF=$P($G(^DGPM(ADMIT,0)),"^",16)
75 I PTF,$D(^DGP(45.84,+PTF)) S DGPME="Associated PTF (#"_PTF_") is not open. Cannot edit this movement."
76 Q
Note: See TracBrowser for help on using the repository browser.