- DGPMV ;ALB/MRL/MIR - PATIENT MOVEMENT DRIVER; 10 MAR 89
- ;;5.3;Registration;**60,200,268,993**;Aug 13, 1993;Build 92
- ;
- ;OPTION VALUE OF DGPMT
- ;------ --------------
- ;admit 1
- ;transfer 2
- ;discharge 3
- ;check-in 4
- ;check-out 5
- ;t.s. transfer 6
- ;
- PAT K ORACTION,ORMENU
- D LO^DGUTL I '$D(IOF) S IOP=$S($D(ION):ION,1:"HOME") D ^%ZIS K IOP
- PAT1 W ! I DGPMT=5 S DGPMN=0 D SPCLU^DGPMV0 G OREN:'DGER,Q
- 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: "
- ;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
- ;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)
- 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)
- OREN S DGUSEOR=$$USINGOR()
- I DGUSEOR Q:'$D(ORVP) S DFN=+ORVP,DGPMN="",Y(0)=$G(^DPT(DFN,0))
- I $$LODGER(DFN)&(DGPMT=1) D Q
- .W !,*7,"Patient is a lodger...you can not add an admission!"
- .W !," Press RETURN to continue"
- .R XTEMP:30
- .D DISPOQ K DGPMDER
- MOVE ;
- S XQORQUIT=1,DGPME=0 D UC
- 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
- CHK D:DGPMN REG I 'DGPME,$D(^DPT(DFN,.35)),+^(.35) S Y=+^(.35) D DIED
- 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
- D:'DGPME ^DGPMV1 G PAT1:'DGUSEOR,Q
- ;
- REG ;new patient
- D NEW^DGRP
- 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
- Q:%>0 I % S DGPME=1 Q
- W !?4,"Answer YES if you want to load 10/10 data at this time otherwise answer NO.",*7 G REG
- ;
- DIED X ^DD("DD") W !!,"PATIENT EXPIRED '",Y,"'...WANT TO CONTINUE" S %=2 D YN^DICN Q:%=1 I % S DGPME=1 Q
- W !?4,*7,"Answer YES if you want to continue this process even though the patient",!?4,"has expired otherwise answer NO!" G DIED
- ;
- Q K %,DFN,DGER,DGPM5X,DGODS,DGODSON,DGPMUC,DGPME,DGPMN,DGPMT,DGPMPC,DIC,X,Y,^UTILITY("VAIP",$J) D KVAR^VADPT
- I '$G(DGUSEOR) K XQORQUIT
- K DGUSEOR
- Q
- ;
- UC ; -- set type of mvt literal
- S DGPMUC=$P("ADMISSION^TRANSFER^DISCHARGE^LODGER CHECK-IN^CHECK-OUT LODGER^SPECIALTY TRANSFER^ROOM-BED CHANGE","^",DGPMT)
- I DGPMT=6,$D(DGPMPC) S DGPMUC="PROVIDER CHANGE"
- Q
- ;
- CA ; -- bypass interactive process and allows editing of past admission
- ; mvts
- ;
- ; input: DFN
- ; DGPMT - mvt transaction type
- ; DGPMCA - coresp. adm
- ;
- ; output: Y - the mvt entry added/edited
- ;
- D UC
- K VAIP S VAIP("E")=DGPMCA N DGPMCA D INP^DGPMV10
- S DGPMBYP="" D C^DGPMV1
- S Y=DGPMBYP K DGPMUC,DGPMBYP
- Q
- DISPO ;called from admission disposition types
- ;input DGPMSVC=SVC OF WARD REQUIRED (FROM DISPOSITION TYPE FILE)
- ; DFN=patient file IFN (this variable is NOT killed on exit)
- ;output DGPMDER=disposition error?? - FOR FUTURE USE
- ;
- S DGPMT=1,(DGPML,DGPMMD)="" K DGPMDER,VAIP S VAIP("D")="L" D UC^DGPMV,INP^DGPMV10,NOW^%DTC
- I DGPMVI(1)&('DGPMDCD!(DGPMDCD>%)) W !,"Patient is already an inpatient...editing the admission is not allowed." D DISPOQ K DGPMDER Q
- I $$LODGER(DFN) W !,*7,"Patient is a lodger...you can not add an admission!" D DISPOQ K DGPMDER Q
- ;next line should be involked in future release to error if wrong service
- ;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
- 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
- S DEF="NOW",DGPM1X=0 D SEL^DGPMV2 I '$D(DGPMDER) S DGPMDER=1
- DISPOQ D Q^DGPMV1 K DGODS,DGODSON,DGPMT,DGPMSV,DGPMSVC,DGPMUC,DGPMN,^UTILITY("VAIP",$J) Q
- ;
- USINGOR() ; return a 1 if OE/RR option is being used or 0 otherwise
- N RETURN,X
- S RETURN=0,X=+$$VERSION^XPDUTL("OR")
- I X<3,$D(ORACTION) S RETURN=1
- I X'<3,$D(ORMENU) S RETURN=1
- Q RETURN
- LODGER(DFN) ; Determine lodger status
- ; Input: DFN=patient IEN
- ; Output: '1' if currently a lodger, '0' otherwise
- N DGPMDCD,DGPMVI,I,X
- D LODGER^DGPMV10
- Q DGPMVI(2)=4
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGPMV 4590 printed Feb 19, 2025@00:16:07 Page 2
- DGPMV ;ALB/MRL/MIR - PATIENT MOVEMENT DRIVER; 10 MAR 89
- +1 ;;5.3;Registration;**60,200,268,993**;Aug 13, 1993;Build 92
- +2 ;
- +3 ;OPTION VALUE OF DGPMT
- +4 ;------ --------------
- +5 ;admit 1
- +6 ;transfer 2
- +7 ;discharge 3
- +8 ;check-in 4
- +9 ;check-out 5
- +10 ;t.s. transfer 6
- +11 ;
- PAT KILL ORACTION,ORMENU
- +1 DO LO^DGUTL
- IF '$DATA(IOF)
- SET IOP=$SELECT($DATA(ION):ION,1:"HOME")
- DO ^%ZIS
- KILL IOP
- PAT1 WRITE !
- IF DGPMT=5
- SET DGPMN=0
- DO SPCLU^DGPMV0
- if 'DGER
- GOTO OREN
- GOTO Q
- +1 SET DIC="^DPT("
- SET DIC(0)="AEQMZ"
- SET DIC("A")=$SELECT('$DATA(DGPMPC):$PIECE("Admit^Transfer^Discharge^Check-in^Check-out^Specialty Change for","^",DGPMT),1:"Provider Change for")_" PATIENT: "
- +2 ;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
- +3 ;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)
- +4 if "^1^4^"'[("^"_DGPMT_"^")
- SET DIC("S")="I $D(^DGPM($S(DGPMT'=5:""APTT1"",1:""APTT4""),+Y))"
- DO ^DIC
- KILL DIC
- if Y'>0
- GOTO Q
- SET DFN=+Y
- SET DGPMN=$PIECE(Y,"^",3)
- OREN SET DGUSEOR=$$USINGOR()
- +1 IF DGUSEOR
- if '$DATA(ORVP)
- QUIT
- SET DFN=+ORVP
- SET DGPMN=""
- SET Y(0)=$GET(^DPT(DFN,0))
- +2 IF $$LODGER(DFN)&(DGPMT=1)
- Begin DoDot:1
- +3 WRITE !,*7,"Patient is a lodger...you can not add an admission!"
- +4 WRITE !," Press RETURN to continue"
- +5 READ XTEMP:30
- +6 DO DISPOQ
- KILL DGPMDER
- End DoDot:1
- QUIT
- MOVE ;
- +1 SET XQORQUIT=1
- SET DGPME=0
- DO UC
- +2 if "^1^4^"[("^"_DGPMT_"^")
- GOTO CHK
- IF '$DATA(^DGPM("APTT"_$SELECT(DGPMT'=5:1,1:4),DFN))
- WRITE !!,"'",$PIECE(Y(0),"^",1),"' HAS NEVER BEEN ",$SELECT(DGPMT'=5:"ADMITTED",1:"CHECK-IN")," TO THE DHCP ADMISSIONS MODULE"
- if 'DGUSEOR
- GOTO PAT1
- GOTO Q
- CHK if DGPMN
- DO REG
- IF 'DGPME
- IF $DATA(^DPT(DFN,.35))
- IF +^(.35)
- SET Y=+^(.35)
- DO DIED
- +1 DO NEW^DGPMVODS
- IF $SELECT('DGODSON:0,'$DATA(^DPT(DFN,.32)):1,'$DATA(^DIC(21,+$PIECE(^(.32),"^",3),0)):1,1:0)
- SET DGPME=1
- +2 if 'DGPME
- DO ^DGPMV1
- if 'DGUSEOR
- GOTO PAT1
- GOTO Q
- +3 ;
- REG ;new patient
- +1 DO NEW^DGRP
- +2 WRITE !!,"NEW PATIENT! WANT TO LOAD 10-10 DATA NOW"
- SET %=1
- DO YN^DICN
- IF %=1
- DO ENED^DGRP
- if '$DATA(^DPT(DFN,0))
- SET DGPME=1
- QUIT
- +3 if %>0
- QUIT
- IF %
- SET DGPME=1
- QUIT
- +4 WRITE !?4,"Answer YES if you want to load 10/10 data at this time otherwise answer NO.",*7
- GOTO REG
- +5 ;
- DIED XECUTE ^DD("DD")
- WRITE !!,"PATIENT EXPIRED '",Y,"'...WANT TO CONTINUE"
- SET %=2
- DO YN^DICN
- if %=1
- QUIT
- IF %
- SET DGPME=1
- QUIT
- +1 WRITE !?4,*7,"Answer YES if you want to continue this process even though the patient",!?4,"has expired otherwise answer NO!"
- GOTO DIED
- +2 ;
- Q KILL %,DFN,DGER,DGPM5X,DGODS,DGODSON,DGPMUC,DGPME,DGPMN,DGPMT,DGPMPC,DIC,X,Y,^UTILITY("VAIP",$JOB)
- DO KVAR^VADPT
- +1 IF '$GET(DGUSEOR)
- KILL XQORQUIT
- +2 KILL DGUSEOR
- +3 QUIT
- +4 ;
- UC ; -- set type of mvt literal
- +1 SET DGPMUC=$PIECE("ADMISSION^TRANSFER^DISCHARGE^LODGER CHECK-IN^CHECK-OUT LODGER^SPECIALTY TRANSFER^ROOM-BED CHANGE","^",DGPMT)
- +2 IF DGPMT=6
- IF $DATA(DGPMPC)
- SET DGPMUC="PROVIDER CHANGE"
- +3 QUIT
- +4 ;
- CA ; -- bypass interactive process and allows editing of past admission
- +1 ; mvts
- +2 ;
- +3 ; input: DFN
- +4 ; DGPMT - mvt transaction type
- +5 ; DGPMCA - coresp. adm
- +6 ;
- +7 ; output: Y - the mvt entry added/edited
- +8 ;
- +9 DO UC
- +10 KILL VAIP
- SET VAIP("E")=DGPMCA
- NEW DGPMCA
- DO INP^DGPMV10
- +11 SET DGPMBYP=""
- DO C^DGPMV1
- +12 SET Y=DGPMBYP
- KILL DGPMUC,DGPMBYP
- +13 QUIT
- DISPO ;called from admission disposition types
- +1 ;input DGPMSVC=SVC OF WARD REQUIRED (FROM DISPOSITION TYPE FILE)
- +2 ; DFN=patient file IFN (this variable is NOT killed on exit)
- +3 ;output DGPMDER=disposition error?? - FOR FUTURE USE
- +4 ;
- +5 SET DGPMT=1
- SET (DGPML,DGPMMD)=""
- KILL DGPMDER,VAIP
- SET VAIP("D")="L"
- DO UC^DGPMV
- DO INP^DGPMV10
- DO NOW^%DTC
- +6 IF DGPMVI(1)&('DGPMDCD!(DGPMDCD>%))
- WRITE !,"Patient is already an inpatient...editing the admission is not allowed."
- DO DISPOQ
- KILL DGPMDER
- QUIT
- +7 IF $$LODGER(DFN)
- WRITE !,*7,"Patient is a lodger...you can not add an admission!"
- DO DISPOQ
- KILL DGPMDER
- QUIT
- +8 ;next line should be involked in future release to error if wrong service
- +9 ;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
- +10 DO NEW^DGPMVODS
- IF $SELECT('DGODSON:0,'$DATA(^DPT(DFN,.32)):1,'$DATA(^DIC(21,+$PIECE(^(.32),"^",3),0)):1,1:0)
- SET DGPME=1
- +11 SET DEF="NOW"
- SET DGPM1X=0
- DO SEL^DGPMV2
- IF '$DATA(DGPMDER)
- SET DGPMDER=1
- DISPOQ DO Q^DGPMV1
- KILL DGODS,DGODSON,DGPMT,DGPMSV,DGPMSVC,DGPMUC,DGPMN,^UTILITY("VAIP",$JOB)
- QUIT
- +1 ;
- USINGOR() ; return a 1 if OE/RR option is being used or 0 otherwise
- +1 NEW RETURN,X
- +2 SET RETURN=0
- SET X=+$$VERSION^XPDUTL("OR")
- +3 IF X<3
- IF $DATA(ORACTION)
- SET RETURN=1
- +4 IF X'<3
- IF $DATA(ORMENU)
- SET RETURN=1
- +5 QUIT RETURN
- LODGER(DFN) ; Determine lodger status
- +1 ; Input: DFN=patient IEN
- +2 ; Output: '1' if currently a lodger, '0' otherwise
- +3 NEW DGPMDCD,DGPMVI,I,X
- +4 DO LODGER^DGPMV10
- +5 QUIT DGPMVI(2)=4