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

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

initial load of WorldVistAEHR

File size: 4.1 KB
RevLine 
[613]1DGPMV ;ALB/MRL/MIR - PATIENT MOVEMENT DRIVER; 10 MAR 89
2 ;;5.3;Registration;**60,200,268**;Aug 13, 1993
3 ;
4 ;OPTION VALUE OF DGPMT
5 ;------ --------------
6 ;admit 1
7 ;transfer 2
8 ;discharge 3
9 ;check-in 4
10 ;check-out 5
11 ;t.s. transfer 6
12 ;
13PAT K ORACTION,ORMENU
14 D LO^DGUTL I '$D(IOF) S IOP=$S($D(ION):ION,1:"HOME") D ^%ZIS K IOP
15PAT1 W ! I DGPMT=5 S DGPMN=0 D SPCLU^DGPMV0 G OREN:'DGER,Q
16 S DIC="^DPT(",DIC(0)="AEQMZ",DIC("A")=$S('$D(DGPMPC):$P("Admit^Transfer^Discharge^Check-in^Check-out^Specialty Change for","^",DGPMT),1:"Provider Change for")_" PATIENT: "
17 S:DGPMT=1 DIC(0)=DIC(0)_"L",DLAYGO=2 S:"^1^4^"'[("^"_DGPMT_"^") DIC("S")="I $D(^DGPM($S(DGPMT'=5:""APTT1"",1:""APTT4""),+Y))" D ^DIC K DIC,DLAYGO G Q:Y'>0 S DFN=+Y,DGPMN=$P(Y,"^",3)
18OREN S DGUSEOR=$$USINGOR()
19 I DGUSEOR Q:'$D(ORVP) S DFN=+ORVP,DGPMN="",Y(0)=$G(^DPT(DFN,0))
20 I $$LODGER(DFN)&(DGPMT=1) D Q
21 .W !,*7,"Patient is a lodger...you can not add an admission!"
22 .W !," Press RETURN to continue"
23 .R XTEMP:30
24 .D DISPOQ K DGPMDER
25MOVE ;
26 S XQORQUIT=1,DGPME=0 D UC
27 G CHK:"^1^4^"[("^"_DGPMT_"^") I '$D(^DGPM("APTT"_$S(DGPMT'=5:1,1:4),DFN)) W !!,"'",$P(Y(0),"^",1),"' HAS NEVER BEEN ",$S(DGPMT'=5:"ADMITTED",1:"CHECK-IN")," TO THE DHCP ADMISSIONS MODULE" G PAT1:'DGUSEOR,Q
28CHK D:DGPMN REG I 'DGPME,$D(^DPT(DFN,.35)),+^(.35) S Y=+^(.35) D DIED
29 D NEW^DGPMVODS I $S('DGODSON:0,'$D(^DPT(DFN,.32)):1,'$D(^DIC(21,+$P(^(.32),"^",3),0)):1,1:0) S DGPME=1
30 D:'DGPME ^DGPMV1 G PAT1:'DGUSEOR,Q
31 ;
32REG ;new patient
33 D NEW^DGRP
34 W !!,"NEW PATIENT! WANT TO LOAD 10-10 DATA NOW" S %=1 D YN^DICN I %=1 D ENED^DGRP S:'$D(^DPT(DFN,0)) DGPME=1 Q
35 Q:%>0 I % S DGPME=1 Q
36 W !?4,"Answer YES if you want to load 10/10 data at this time otherwise answer NO.",*7 G REG
37 ;
38DIED X ^DD("DD") W !!,"PATIENT EXPIRED '",Y,"'...WANT TO CONTINUE" S %=2 D YN^DICN Q:%=1 I % S DGPME=1 Q
39 W !?4,*7,"Answer YES if you want to continue this process even though the patient",!?4,"has expired otherwise answer NO!" G DIED
40 ;
41Q K %,DFN,DGER,DGPM5X,DGODS,DGODSON,DGPMUC,DGPME,DGPMN,DGPMT,DGPMPC,DIC,X,Y,^UTILITY("VAIP",$J) D KVAR^VADPT
42 I '$G(DGUSEOR) K XQORQUIT
43 K DGUSEOR
44 Q
45 ;
46UC ; -- set type of mvt literal
47 S DGPMUC=$P("ADMISSION^TRANSFER^DISCHARGE^LODGER CHECK-IN^CHECK-OUT LODGER^SPECIALTY TRANSFER^ROOM-BED CHANGE","^",DGPMT)
48 I DGPMT=6,$D(DGPMPC) S DGPMUC="PROVIDER CHANGE"
49 Q
50 ;
51CA ; -- bypass interactive process and allows editing of past admission
52 ; mvts
53 ;
54 ; input: DFN
55 ; DGPMT - mvt transaction type
56 ; DGPMCA - coresp. adm
57 ;
58 ; output: Y - the mvt entry added/edited
59 ;
60 D UC
61 K VAIP S VAIP("E")=DGPMCA N DGPMCA D INP^DGPMV10
62 S DGPMBYP="" D C^DGPMV1
63 S Y=DGPMBYP K DGPMUC,DGPMBYP
64 Q
65DISPO ;called from admission disposition types
66 ;input DGPMSVC=SVC OF WARD REQUIRED (FROM DISPOSITION TYPE FILE)
67 ; DFN=patient file IFN (this variable is NOT killed on exit)
68 ;output DGPMDER=disposition error?? - FOR FUTURE USE
69 ;
70 S DGPMT=1,(DGPML,DGPMMD)="" K DGPMDER,VAIP S VAIP("D")="L" D UC^DGPMV,INP^DGPMV10,NOW^%DTC
71 I DGPMVI(1)&('DGPMDCD!(DGPMDCD>%)) W !,"Patient is already an inpatient...editing the admission is not allowed." D DISPOQ K DGPMDER Q
72 I $$LODGER(DFN) W !,*7,"Patient is a lodger...you can not add an admission!" D DISPOQ K DGPMDER Q
73 ;next line should be involked in future release to error if wrong service
74 ;I DGPMVI(1)&('DGPMDCD!(DGPMDCD>%)) S DGPMDER=$S(DGPMSVC="H"&("^NH^D^"'[("^"_DGPMSV_"^")):0,DGPMSVC=DGPMSV:0,1:1) W:DGPMDER=1 "Current inpatient, but not to proper service" Q
75 D NEW^DGPMVODS I $S('DGODSON:0,'$D(^DPT(DFN,.32)):1,'$D(^DIC(21,+$P(^(.32),"^",3),0)):1,1:0) S DGPME=1
76 S DEF="NOW",DGPM1X=0 D SEL^DGPMV2 I '$D(DGPMDER) S DGPMDER=1
77DISPOQ D Q^DGPMV1 K DGODS,DGODSON,DGPMT,DGPMSV,DGPMSVC,DGPMUC,DGPMN,^UTILITY("VAIP",$J) Q
78 ;
79USINGOR() ; return a 1 if OE/RR option is being used or 0 otherwise
80 N RETURN,X
81 S RETURN=0,X=+$$VERSION^XPDUTL("OR")
82 I X<3,$D(ORACTION) S RETURN=1
83 I X'<3,$D(ORMENU) S RETURN=1
84 Q RETURN
85LODGER(DFN) ; Determine lodger status
86 ; Input: DFN=patient IEN
87 ; Output: '1' if currently a lodger, '0' otherwise
88 N DGPMDCD,DGPMVI,I,X
89 D LODGER^DGPMV10
90 Q DGPMVI(2)=4
Note: See TracBrowser for help on using the repository browser.