Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: DGPMV

DGPMV.m

Go to the documentation of this file.
  1. DGPMV ;ALB/MRL/MIR - PATIENT MOVEMENT DRIVER; 10 MAR 89
  1. ;;5.3;Registration;**60,200,268,993**;Aug 13, 1993;Build 92
  1. ;
  1. ;OPTION VALUE OF DGPMT
  1. ;------ --------------
  1. ;admit 1
  1. ;transfer 2
  1. ;discharge 3
  1. ;check-in 4
  1. ;check-out 5
  1. ;t.s. transfer 6
  1. ;
  1. PAT K ORACTION,ORMENU
  1. D LO^DGUTL I '$D(IOF) S IOP=$S($D(ION):ION,1:"HOME") D ^%ZIS K IOP
  1. PAT1 W ! I DGPMT=5 S DGPMN=0 D SPCLU^DGPMV0 G OREN:'DGER,Q
  1. 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: "
  1. ;DG*5.3*993; Remove the DLAYGO variable and the "L" from DIC(0) since adding records to the PATIENT file is not allowed for DG ADMIT PATIENT option
  1. ;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)
  1. S:"^1^4^"'[("^"_DGPMT_"^") DIC("S")="I $D(^DGPM($S(DGPMT'=5:""APTT1"",1:""APTT4""),+Y))" D ^DIC K DIC G Q:Y'>0 S DFN=+Y,DGPMN=$P(Y,"^",3)
  1. OREN S DGUSEOR=$$USINGOR()
  1. I DGUSEOR Q:'$D(ORVP) S DFN=+ORVP,DGPMN="",Y(0)=$G(^DPT(DFN,0))
  1. I $$LODGER(DFN)&(DGPMT=1) D Q
  1. .W !,*7,"Patient is a lodger...you can not add an admission!"
  1. .W !," Press RETURN to continue"
  1. .R XTEMP:30
  1. .D DISPOQ K DGPMDER
  1. MOVE ;
  1. S XQORQUIT=1,DGPME=0 D UC
  1. 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
  1. CHK D:DGPMN REG I 'DGPME,$D(^DPT(DFN,.35)),+^(.35) S Y=+^(.35) D DIED
  1. 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
  1. D:'DGPME ^DGPMV1 G PAT1:'DGUSEOR,Q
  1. ;
  1. REG ;new patient
  1. D NEW^DGRP
  1. 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
  1. Q:%>0 I % S DGPME=1 Q
  1. W !?4,"Answer YES if you want to load 10/10 data at this time otherwise answer NO.",*7 G REG
  1. ;
  1. DIED X ^DD("DD") W !!,"PATIENT EXPIRED '",Y,"'...WANT TO CONTINUE" S %=2 D YN^DICN Q:%=1 I % S DGPME=1 Q
  1. W !?4,*7,"Answer YES if you want to continue this process even though the patient",!?4,"has expired otherwise answer NO!" G DIED
  1. ;
  1. Q K %,DFN,DGER,DGPM5X,DGODS,DGODSON,DGPMUC,DGPME,DGPMN,DGPMT,DGPMPC,DIC,X,Y,^UTILITY("VAIP",$J) D KVAR^VADPT
  1. I '$G(DGUSEOR) K XQORQUIT
  1. K DGUSEOR
  1. Q
  1. ;
  1. UC ; -- set type of mvt literal
  1. S DGPMUC=$P("ADMISSION^TRANSFER^DISCHARGE^LODGER CHECK-IN^CHECK-OUT LODGER^SPECIALTY TRANSFER^ROOM-BED CHANGE","^",DGPMT)
  1. I DGPMT=6,$D(DGPMPC) S DGPMUC="PROVIDER CHANGE"
  1. Q
  1. ;
  1. CA ; -- bypass interactive process and allows editing of past admission
  1. ; mvts
  1. ;
  1. ; input: DFN
  1. ; DGPMT - mvt transaction type
  1. ; DGPMCA - coresp. adm
  1. ;
  1. ; output: Y - the mvt entry added/edited
  1. ;
  1. D UC
  1. K VAIP S VAIP("E")=DGPMCA N DGPMCA D INP^DGPMV10
  1. S DGPMBYP="" D C^DGPMV1
  1. S Y=DGPMBYP K DGPMUC,DGPMBYP
  1. Q
  1. DISPO ;called from admission disposition types
  1. ;input DGPMSVC=SVC OF WARD REQUIRED (FROM DISPOSITION TYPE FILE)
  1. ; DFN=patient file IFN (this variable is NOT killed on exit)
  1. ;output DGPMDER=disposition error?? - FOR FUTURE USE
  1. ;
  1. S DGPMT=1,(DGPML,DGPMMD)="" K DGPMDER,VAIP S VAIP("D")="L" D UC^DGPMV,INP^DGPMV10,NOW^%DTC
  1. I DGPMVI(1)&('DGPMDCD!(DGPMDCD>%)) W !,"Patient is already an inpatient...editing the admission is not allowed." D DISPOQ K DGPMDER Q
  1. I $$LODGER(DFN) W !,*7,"Patient is a lodger...you can not add an admission!" D DISPOQ K DGPMDER Q
  1. ;next line should be involked in future release to error if wrong service
  1. ;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
  1. 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
  1. S DEF="NOW",DGPM1X=0 D SEL^DGPMV2 I '$D(DGPMDER) S DGPMDER=1
  1. DISPOQ D Q^DGPMV1 K DGODS,DGODSON,DGPMT,DGPMSV,DGPMSVC,DGPMUC,DGPMN,^UTILITY("VAIP",$J) Q
  1. ;
  1. USINGOR() ; return a 1 if OE/RR option is being used or 0 otherwise
  1. N RETURN,X
  1. S RETURN=0,X=+$$VERSION^XPDUTL("OR")
  1. I X<3,$D(ORACTION) S RETURN=1
  1. I X'<3,$D(ORMENU) S RETURN=1
  1. Q RETURN
  1. LODGER(DFN) ; Determine lodger status
  1. ; Input: DFN=patient IEN
  1. ; Output: '1' if currently a lodger, '0' otherwise
  1. N DGPMDCD,DGPMVI,I,X
  1. D LODGER^DGPMV10
  1. Q DGPMVI(2)=4