| 1 | DGPMV ;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 | ;
|
|---|
| 13 | PAT K ORACTION,ORMENU
|
|---|
| 14 | D LO^DGUTL I '$D(IOF) S IOP=$S($D(ION):ION,1:"HOME") D ^%ZIS K IOP
|
|---|
| 15 | PAT1 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)
|
|---|
| 18 | OREN 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
|
|---|
| 25 | MOVE ;
|
|---|
| 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
|
|---|
| 28 | CHK 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 | ;
|
|---|
| 32 | REG ;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 | ;
|
|---|
| 38 | DIED 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 | ;
|
|---|
| 41 | Q 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 | ;
|
|---|
| 46 | UC ; -- 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 | ;
|
|---|
| 51 | CA ; -- 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
|
|---|
| 65 | DISPO ;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
|
|---|
| 77 | DISPOQ D Q^DGPMV1 K DGODS,DGODSON,DGPMT,DGPMSV,DGPMSVC,DGPMUC,DGPMN,^UTILITY("VAIP",$J) Q
|
|---|
| 78 | ;
|
|---|
| 79 | USINGOR() ; 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
|
|---|
| 85 | LODGER(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
|
|---|
