BDGDSA ;IHS/ITSC/WAR - ENTER/EDIT DAY SURGERY [ 01/07/2005 5:08 PM ]
;;5.3;PIMS;**1001,1003,1004,1005,1010,1011,1012**;MAY 28, 2004
;IHS/ITSC/LJF 06/22/2005 PATCH 1003 set DFN properly so entries without zero nodes are not used
;IHS/OIT/LJF 08/26/2005 PATCH 1004 search for visit already created but ignore time
; 11/09/2005 PATCH 1004 added check in case entry was deleted
; 05/04/2006 PATCH 1005 if default visit type not set in one file, check another
;cmi/anch/maw 11/20/2008 PATCH 1010 added call to day surgery movement event driver
;
;This was a rewrite of ADGDSA. Basic logic for this rtn...
; DFN is used as a switch for processing, looping or quiting.
;If DFN is positive... keep processing
;If DFN is negitive... do the main loop (F Q:'DFN D)
;If DFN is zero... quit this routine
;
;IHS/ITSC/WAR 4/14/04 IHS/ITSC/WAR 5/4/2004 PATCH #1001 mod for DUZ(2)
;I '$$GET1^DIQ(9009020.1,1,.15,"I") D
;I '$$GET1^DIQ(9009020.1,$O(^DG(40.8,"C",DUZ(2),0)),.15,"I") D ;cmi/maw 9/1/09 orig line PATCH 1011
I '$$GET1^DIQ(9009020.1,$O(^DG(40.8,"AD",DUZ(2),0)),.15,"I") D ;cmi/maw 9/1/09 mod line PATCH 1011
.W $C(7)
.W !!,"You must have a valid Clinic entered in the DAY SURGERY"
.W !,"HOSP LOCATION, found in the ADT parameters set up",!!!
.D PAUSE^BDGF
E D
.S DFN=-1
.S (BDGDSVST,DGA,DGX,DGDFN1,ADGDFN)=""
.F Q:'DFN D
..D NAME
..I DFN>0 D
...S DA=DFN
...D EN^ADGPI
...I +$G(DUOUT)=1 S DFN=DFN*-1 ;User uphatted out
...I DFN>0 D DECEASED
...S TRUE=$S(DFN<0:1,1:0) ;Used by 'FOR' Loop in DSDTLOCK
...D DSDTLOCK
...I DFN>0 D ;Creates or edits the DS record
....S DIDEL=9009012,DR="[ADGDSADD]",DIE="^ADGDS(",DA=DFN
....S DIE("NO^")="" D ^DIE L -^ADGDS(DFN) K DIE("NO^")
....;ADD CODE... if record deleted DO DELETE (visit etc)
....I '$D(^ADGDS(DFN,"DS",DGDFN1,0)) D Q ;cmi/maw PATCH 1010 RQMT 14 delete the visit if they delete day surgery
..... D DELETE(DFN,DGDSDT)
...I DFN>0 D DSWKSHT ;DaySurg Worksheet
...I DFN>0 D PCCVSIT ;Create PCC visit
...I DFN>0 D MOVE^BDGDSEVT ;cmi/maw 11/20/2008 PATCH 1010 RQMT 14 added day surgery event driver
...I DFN>0 D
....I $D(^ADGDS(DFN,"DS",DGDFN1,2)),$P(^(2),U)'="" D DSIC
D KILL^ADGUTIL K ADGDFN,ADGDFN1,BDGDSVST,DGA,DGX,DGDFN1
Q
;
NAME ;*** Get Pt name
K DIC,DAT,DFN
W !! S DIC=9009012,DLAYGO=9009012,DIC(0)="AQEML"
S DIC("A")="Select Day Surgery Patient: "
;set DIC("S") to check for unregistered patients
S DIC("S")="I $D(^AUPNPAT(+Y,41,DUZ(2),0)),$P(^(0),U,2)'="""""
D ^DIC K DIC("A")
;
;IHS/ITSC/LJF 6/22/2005 PATCH 1003 set DFN properly
S DFN=+Y
;I +$G(DFN)=0!(+$G(DUOUT)=1) S DFN=0 ;User wants to quit
I +$G(DFN)<1!(+$G(DUOUT)=1) S DFN=0 ;User wants to quit
;
Q
;
DECEASED ;
I $D(^DPT(DFN,.35)),$P(^(.35),U)]"" D
. K DIR S DIR(0)="Y"
. S DIR("A")="This patient has died. Sure you want to continue"
. S DIR("B")="NO" D ^DIR
.I Y=0 S DFN=DFN*-1
Q
;
DSDTLOCK ;Get DS date and check for locks
F Q:TRUE D
.K DIC S:'$D(^ADGDS(DFN,"DS",0)) ^(0)="^9009012.01D^^"
.S DIC="^ADGDS("_DFN_",""DS"",",DLAYGO=9009012,DIC(0)="AEQMZL"
.S DA(1)=DFN,DA=0,DGA=$P(^ADGDS(DFN,"DS",0),U,3)
.I DGA'=""!($O(^ADGDS(DFN,"DS",0))) D
..S DIC("B")=$S('$D(^ADGDS(DFN,"DS",DGA,2)):DGA,$P(^(2),U)="":DGA,1:"")
.;
.L +^ADGDS(DFN,"DS"):3 I '$T D
..W !,*7,"SOMEONE IS UPDATING THIS DAY SURGERY PATIENT; TRY AGAIN LATER"
..S TRUE=1,DFN=(DFN*-1)
.I DFN>0 D
..D ^DIC L -^ADGDS(DFN,"DS") W !! K DIC,DIC("A")
..I Y'>0 D
...S TRUE=1,DFN=(DFN*-1)
..E D
...S DGDFN1=+Y
...S DGDSDT=+$G(^ADGDS(DFN,"DS",DGDFN1,0)) ;cmi/maw 5/15/2009 added for day surgery date to delete stuff with
.;
.I DFN>0 D
..I 'TRUE,$D(^ADGDS(DFN,"DS",DGDFN1,2)),$P(^(2),U)'="" D
...W !?5,*7,"Past day surgeries must be edited in the Edit Past Day Surhery option",!
..E D
...L +^ADGDS(DFN):3
...I '$T D
....W !,*7,"SOMEONE IS UPDATING THIS ENTRY; TRY AGAIN LATER"
....S DFN=DFN*-1
...E D
....S TRUE=1
Q
DSWKSHT ;Day Surg worksheet
K DIR S DIR("A")="Print Day Surgery Worksheet",DIR(0)="Y"
S DIR("?")="Enter YES to print a worksheet for this patient"
S DIR("B")="NO" D ^DIR
I Y=1 D
.S ADGDFN=DFN,ADGDFN1=DGDFN1 D DS1^ADGCRB0 S DFN=ADGDFN,DGDFN1=ADGDFN1
Q
;
DELETE(DF,DSDT) ;-- delete the day surgery and visit PATCH 1010 RQMT 13
N BDGDSVST,FOUND
S (BDGDSVST,FOUND)=0
F S BDGDSVST=$O(^AUPNVSIT("AA",DF,DSDT,BDGDSVST)) Q:BDGDSVST=""!(FOUND) D
.I $P(^AUPNVSIT(BDGDSVST,0),U,7)="S" D ;Day Surgery vst
..I $P(^AUPNVSIT(BDGDSVST,0),U,6)=DUZ(2) S FOUND=BDGDSVST
Q:'$G(FOUND)
Q:$P($G(^AUPNVSIT(FOUND,0)),U,9) ;don't continue if more dependent entry count is greater than 0
S APCDVDLT=FOUND
D ^APCDVDLT
Q
;
PCCVSIT ;***> create visit in PCC for day surgery
S PKG=$O(^DIC(9.4,"C","PIMS",0)) ;Get IEN for PIMS pkg
;
;If OP only site OR 'PASS DATA TO PCC' in PCC MastrCntl file not YES
;I $P(^DG(40.8,$O(^DG(40.8,"C",DUZ(2),0)),0),"^",3)!('+$P($G(^APCCCTRL(DUZ(2),11,PKG,0)),U,2)) D ;cmi/maw 9/1/09 orig line PATCH 1011
I $P(^DG(40.8,$O(^DG(40.8,"AD",DUZ(2),0)),0),"^",3)!('+$P($G(^APCCCTRL(DUZ(2),11,PKG,0)),U,2)) D ;cmi/maw 9/1/09 mod line PATCH 1011
.W !!,"Outpatient only site 'OR' PCC link not setup - visit not created"
.S DFN=0
E D
.;
.;IHS/OIT/LJF 11/09/2005 PATCH 1004 prevent error in case of deletions
.;S APCDALVR("APCDDATE")=+^ADGDS(DFN,"DS",DGDFN1,0) ;visit date
.S APCDALVR("APCDDATE")=+$G(^ADGDS(DFN,"DS",DGDFN1,0)) Q:'APCDALVR("APCDDATE") ;visit date
.;
.;check if visit already exists
.S DGX=APCDALVR("APCDDATE"),DGX1=9999999-$P(DGX,".")_"."_$P(DGX,".",2)
.;
.D FINDVST(.DGX1) ;IHS/OIT/LJF 8/26/2005 PATCH 1004 reset date/time to checked in visit
.;
.I $D(^AUPNVSIT("AA",DFN,DGX1)) D
..N A S A=0
..F S A=$O(^AUPNVSIT("AA",DFN,DGX1,A)) Q:A=""!(DFN<0) D
...I $P(^AUPNVSIT(A,0),U,7)="S" S DFN=DFN*-1,BDGDSVST=A ;visit found
...W !!,"Day Surgery VISIT was found..."
.I DFN>0 D
..; Visit not found, so create one
..S APCDALVR("APCDADD")=1 D APCDEIN^ADGCALLS ;initialize PCC variables
..W !!,"Day Surgery VISIT being created..."
..S APCDALVR("APCDPAT")=DFN,APCDALVR("APCDLOC")=APCDDUZ2
..;IHS/ITSC/WAR 4/14/04 Add Hosp Loc
..S APCDALVR("APCDHL")=$$GET1^DIQ(9009020.1,1,.15,"I")
..;IHS/ITSC/WAR 1/28/04 Mod to handle different types of Facilities
..;S APCDALVR("APCDTYPE")="I",APCDALVR("APCDCAT")="S"
..S APCDALVR("APCDTYPE")=$$GET1^DIQ(9001001.2,APCDALVR("APCDLOC"),.11,"I"),APCDALVR("APCDCAT")="S"
..I APCDALVR("APCDTYPE")="" S APCDALVR("APCDTYPE")=$$GET1^DIQ(9001000,DUZ(2),.04,"I") ;IHS/OIT/LJF 05/04/2006 PATCH 1005
..S APCDALVR("APCDCLN")="DAY SURGERY" D DSCV^ADGCALLS K AUPNSEX
..;
..S APCDALVR("APCDDATE")=+^ADGDS(DFN,"DS",DGDFN1,0) ;visit date
..;get visit entry
..S DGX=APCDALVR("APCDDATE"),DGX1=9999999-$P(DGX,".")_"."_$P(DGX,".",2)
..K APCDALVR
..S (BDGDSVST,FOUND)=0
..F S BDGDSVST=$O(^AUPNVSIT("AA",DFN,DGX1,BDGDSVST)) Q:BDGDSVST=""!(FOUND) D
...I $P(^AUPNVSIT(BDGDSVST,0),U,7)="S" D ;Day Surgery vst
....I $P(^AUPNVSIT(BDGDSVST,0),U,6)=DUZ(2) S FOUND=BDGDSVST
..S BDGDSVST=FOUND
..I +BDGDSVST=0 W !!,*7,"VISIT ERROR, Please notify your supervisor!" D
...S DFN=0
.E D
..S DFN=DFN*-1 ; reset the DFN to positive
Q
;
DSIC ;***> create incomplete chart entry
;IHS/ITSC/WAR 12/10/03 This section copied from BDGICEVT and modified
;
S (BDGICREC,X)=""
F S X=$O(^BDGIC("B",DFN,X)) Q:X=""!(BDGICREC) D
.;Check IC Disch date/time v.s. DaySurg Release date/time
.I $P(^BDGIC(X,0),U,2)=$P(^ADGDS(DFN,"DS",DGDFN1,2),U,1) S BDGICREC=X
I +BDGICREC=0 D
.S VST=BDGDSVST
.S SERV=+$P(^ADGDS(DFN,"DS",DGDFN1,0),U,5)
.S SRDATE=DGX
.W !!,"Creating entry in Incomplete Chart file....",! K DIC
.; make FM call to stuff data
.S X=DFN,DIC="^BDGIC(",DLAYGO=9009016.1,DIC(0)="L"
.; 4 slash visit to bypass file screen
.S DIC("DR")=".03////"_VST_";.04///`"_SERV_";.05///"_(SRDATE\1)
.L +^BDGIC(0):3 I '$T D
.. Q:$D(DGQUIET)
.. W !,*7,"CANNOT ADD TO INCOMPLETE CHART FILE;"
.. W "BEING UPDATED BY SOMEONE ELSE"
K DD,DO D FILE^DICN L -^BDGIC(0)
K APCDALVR
Q
;
LASTDS(BDGDT,DFN) ;EP; IP AdmDate and Pt being passed to this tag
;Get Pt's most recent DaySurg visit as it relates to IP Adm date
;Release date from DaySurg will be passed back in DSDATE
;If no release date entered yet, Admit date passed back in DSDATE
S DSDATE=0
I $G(^ADGDS(DFN,0)) D ;Pt has at least one entry
.S BDGDT=$O(^ADGDS(DFN,"DS","AA",BDGDT),-1)
.I BDGDT'="" D
..S IEN=$O(^ADGDS(DFN,"DS","AA",BDGDT,0)) ;Get rec#
..I IEN S DSDATE=+$G(^ADGDS(DFN,"DS",IEN,2)) ;Get release date
..;Assumption - if NO release date entered yet
..I 'DSDATE S DSDATE=BDGDT ;return DaySurg ADMIT date
Q DSDATE
;
DSPROC(BDGDT,DFN) ;IP AdmDate and Pt being passed to this tag
;Get free text PROCedure (if there)
S DSPROC=0
I $G(^ADGDS(DFN,0)) D ;Pt has at least one entry
.S BDGDT=$O(^ADGDS(DFN,"DS","AA",BDGDT),-1)
.I BDGDT'="" D
..S IEN=$O(^ADGDS(DFN,"DS","AA",BDGDT,0)) ;Get rec#
..I +IEN D
...S DSDATE=+$G(^ADGDS(DFN,"DS",IEN,2)) ;Get release date
...S DSPROC=$P($G(^ADGDS(DFN,"DS",IEN,0)),U,2) ;Get procedure
Q DSPROC
;
DSDISP(DT,DFN) ;IP AdmDate and Pt being passed to this tag
;Get the DISPosition (if there) - none stored as of 3/4/04 WAR
S DSDISP=0
;
;
Q DSDISP
;
;IHS/OIT/LJF 8/26/2005 PATCH 1004 new subroutine added
FINDVST(DATE) ; reset date/time to that for a day surgery visit if one exists
;temporary fix until day surgery rewrite
NEW DATE1,IEN,FOUND
S FOUND=0
S DATE1=DATE\1 ;take off time
F S DATE1=$O(^AUPNVSIT("AA",DFN,DATE1)) Q:'DATE1 Q:((DATE1\1)'=(DATE\1)) Q:FOUND D
. S IEN=0 F S IEN=$O(^AUPNVSIT("AA",DFN,DATE1,IEN)) Q:'IEN Q:FOUND D
.. I $P(^AUPNVSIT(IEN,0),U,7)="S" S FOUND=1,DATE=DATE1
Q
BDGDSA ;IHS/ITSC/WAR - ENTER/EDIT DAY SURGERY [ 01/07/2005 5:08 PM ]
+1 ;;5.3;PIMS;**1001,1003,1004,1005,1010,1011,1012**;MAY 28, 2004
+2 ;IHS/ITSC/LJF 06/22/2005 PATCH 1003 set DFN properly so entries without zero nodes are not used
+3 ;IHS/OIT/LJF 08/26/2005 PATCH 1004 search for visit already created but ignore time
+4 ; 11/09/2005 PATCH 1004 added check in case entry was deleted
+5 ; 05/04/2006 PATCH 1005 if default visit type not set in one file, check another
+6 ;cmi/anch/maw 11/20/2008 PATCH 1010 added call to day surgery movement event driver
+7 ;
+8 ;This was a rewrite of ADGDSA. Basic logic for this rtn...
+9 ; DFN is used as a switch for processing, looping or quiting.
+10 ;If DFN is positive... keep processing
+11 ;If DFN is negitive... do the main loop (F Q:'DFN D)
+12 ;If DFN is zero... quit this routine
+13 ;
+14 ;IHS/ITSC/WAR 4/14/04 IHS/ITSC/WAR 5/4/2004 PATCH #1001 mod for DUZ(2)
+15 ;I '$$GET1^DIQ(9009020.1,1,.15,"I") D
+16 ;I '$$GET1^DIQ(9009020.1,$O(^DG(40.8,"C",DUZ(2),0)),.15,"I") D ;cmi/maw 9/1/09 orig line PATCH 1011
+17 ;cmi/maw 9/1/09 mod line PATCH 1011
IF '$$GET1^DIQ(9009020.1,$ORDER(^DG(40.8,"AD",DUZ(2),0)),.15,"I")
Begin DoDot:1
+18 WRITE $CHAR(7)
+19 WRITE !!,"You must have a valid Clinic entered in the DAY SURGERY"
+20 WRITE !,"HOSP LOCATION, found in the ADT parameters set up",!!!
+21 DO PAUSE^BDGF
End DoDot:1
+22 IF '$TEST
Begin DoDot:1
+23 SET DFN=-1
+24 SET (BDGDSVST,DGA,DGX,DGDFN1,ADGDFN)=""
+25 FOR
IF 'DFN
QUIT
Begin DoDot:2
+26 DO NAME
+27 IF DFN>0
Begin DoDot:3
+28 SET DA=DFN
+29 DO EN^ADGPI
+30 ;User uphatted out
IF +$GET(DUOUT)=1
SET DFN=DFN*-1
+31 IF DFN>0
DO DECEASED
+32 ;Used by 'FOR' Loop in DSDTLOCK
SET TRUE=$SELECT(DFN<0:1,1:0)
+33 DO DSDTLOCK
+34 ;Creates or edits the DS record
IF DFN>0
Begin DoDot:4
+35 SET DIDEL=9009012
SET DR="[ADGDSADD]"
SET DIE="^ADGDS("
SET DA=DFN
+36 SET DIE("NO^")=""
DO ^DIE
LOCK -^ADGDS(DFN)
KILL DIE("NO^")
+37 ;ADD CODE... if record deleted DO DELETE (visit etc)
+38 ;cmi/maw PATCH 1010 RQMT 14 delete the visit if they delete day surgery
IF '$DATA(^ADGDS(DFN,"DS",DGDFN1,0))
Begin DoDot:5
+39 DO DELETE(DFN,DGDSDT)
End DoDot:5
QUIT
End DoDot:4
+40 ;DaySurg Worksheet
IF DFN>0
DO DSWKSHT
+41 ;Create PCC visit
IF DFN>0
DO PCCVSIT
+42 ;cmi/maw 11/20/2008 PATCH 1010 RQMT 14 added day surgery event driver
IF DFN>0
DO MOVE^BDGDSEVT
+43 IF DFN>0
Begin DoDot:4
+44 IF $DATA(^ADGDS(DFN,"DS",DGDFN1,2))
IF $PIECE(^(2),U)'=""
DO DSIC
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+45 DO KILL^ADGUTIL
KILL ADGDFN,ADGDFN1,BDGDSVST,DGA,DGX,DGDFN1
+46 QUIT
+47 ;
NAME ;*** Get Pt name
+1 KILL DIC,DAT,DFN
+2 WRITE !!
SET DIC=9009012
SET DLAYGO=9009012
SET DIC(0)="AQEML"
+3 SET DIC("A")="Select Day Surgery Patient: "
+4 ;set DIC("S") to check for unregistered patients
+5 SET DIC("S")="I $D(^AUPNPAT(+Y,41,DUZ(2),0)),$P(^(0),U,2)'="""""
+6 DO ^DIC
KILL DIC("A")
+7 ;
+8 ;IHS/ITSC/LJF 6/22/2005 PATCH 1003 set DFN properly
+9 SET DFN=+Y
+10 ;I +$G(DFN)=0!(+$G(DUOUT)=1) S DFN=0 ;User wants to quit
+11 ;User wants to quit
IF +$GET(DFN)<1!(+$GET(DUOUT)=1)
SET DFN=0
+12 ;
+13 QUIT
+14 ;
DECEASED ;
+1 IF $DATA(^DPT(DFN,.35))
IF $PIECE(^(.35),U)]""
Begin DoDot:1
+2 KILL DIR
SET DIR(0)="Y"
+3 SET DIR("A")="This patient has died. Sure you want to continue"
+4 SET DIR("B")="NO"
DO ^DIR
+5 IF Y=0
SET DFN=DFN*-1
End DoDot:1
+6 QUIT
+7 ;
DSDTLOCK ;Get DS date and check for locks
+1 FOR
IF TRUE
QUIT
Begin DoDot:1
+2 KILL DIC
IF '$DATA(^ADGDS(DFN,"DS",0))
SET ^(0)="^9009012.01D^^"
+3 SET DIC="^ADGDS("_DFN_",""DS"","
SET DLAYGO=9009012
SET DIC(0)="AEQMZL"
+4 SET DA(1)=DFN
SET DA=0
SET DGA=$PIECE(^ADGDS(DFN,"DS",0),U,3)
+5 IF DGA'=""!($ORDER(^ADGDS(DFN,"DS",0)))
Begin DoDot:2
+6 SET DIC("B")=$SELECT('$DATA(^ADGDS(DFN,"DS",DGA,2)):DGA,$PIECE(^(2),U)="":DGA,1:"")
End DoDot:2
+7 ;
+8 LOCK +^ADGDS(DFN,"DS"):3
IF '$TEST
Begin DoDot:2
+9 WRITE !,*7,"SOMEONE IS UPDATING THIS DAY SURGERY PATIENT; TRY AGAIN LATER"
+10 SET TRUE=1
SET DFN=(DFN*-1)
End DoDot:2
+11 IF DFN>0
Begin DoDot:2
+12 DO ^DIC
LOCK -^ADGDS(DFN,"DS")
WRITE !!
KILL DIC,DIC("A")
+13 IF Y'>0
Begin DoDot:3
+14 SET TRUE=1
SET DFN=(DFN*-1)
End DoDot:3
+15 IF '$TEST
Begin DoDot:3
+16 SET DGDFN1=+Y
+17 ;cmi/maw 5/15/2009 added for day surgery date to delete stuff with
SET DGDSDT=+$GET(^ADGDS(DFN,"DS",DGDFN1,0))
End DoDot:3
End DoDot:2
+18 ;
+19 IF DFN>0
Begin DoDot:2
+20 IF 'TRUE
IF $DATA(^ADGDS(DFN,"DS",DGDFN1,2))
IF $PIECE(^(2),U)'=""
Begin DoDot:3
+21 WRITE !?5,*7,"Past day surgeries must be edited in the Edit Past Day Surhery option",!
End DoDot:3
+22 IF '$TEST
Begin DoDot:3
+23 LOCK +^ADGDS(DFN):3
+24 IF '$TEST
Begin DoDot:4
+25 WRITE !,*7,"SOMEONE IS UPDATING THIS ENTRY; TRY AGAIN LATER"
+26 SET DFN=DFN*-1
End DoDot:4
+27 IF '$TEST
Begin DoDot:4
+28 SET TRUE=1
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+29 QUIT
DSWKSHT ;Day Surg worksheet
+1 KILL DIR
SET DIR("A")="Print Day Surgery Worksheet"
SET DIR(0)="Y"
+2 SET DIR("?")="Enter YES to print a worksheet for this patient"
+3 SET DIR("B")="NO"
DO ^DIR
+4 IF Y=1
Begin DoDot:1
+5 SET ADGDFN=DFN
SET ADGDFN1=DGDFN1
DO DS1^ADGCRB0
SET DFN=ADGDFN
SET DGDFN1=ADGDFN1
End DoDot:1
+6 QUIT
+7 ;
DELETE(DF,DSDT) ;-- delete the day surgery and visit PATCH 1010 RQMT 13
+1 NEW BDGDSVST,FOUND
+2 SET (BDGDSVST,FOUND)=0
+3 FOR
SET BDGDSVST=$ORDER(^AUPNVSIT("AA",DF,DSDT,BDGDSVST))
IF BDGDSVST=""!(FOUND)
QUIT
Begin DoDot:1
+4 ;Day Surgery vst
IF $PIECE(^AUPNVSIT(BDGDSVST,0),U,7)="S"
Begin DoDot:2
+5 IF $PIECE(^AUPNVSIT(BDGDSVST,0),U,6)=DUZ(2)
SET FOUND=BDGDSVST
End DoDot:2
End DoDot:1
+6 IF '$GET(FOUND)
QUIT
+7 ;don't continue if more dependent entry count is greater than 0
IF $PIECE($GET(^AUPNVSIT(FOUND,0)),U,9)
QUIT
+8 SET APCDVDLT=FOUND
+9 DO ^APCDVDLT
+10 QUIT
+11 ;
PCCVSIT ;***> create visit in PCC for day surgery
+1 ;Get IEN for PIMS pkg
SET PKG=$ORDER(^DIC(9.4,"C","PIMS",0))
+2 ;
+3 ;If OP only site OR 'PASS DATA TO PCC' in PCC MastrCntl file not YES
+4 ;I $P(^DG(40.8,$O(^DG(40.8,"C",DUZ(2),0)),0),"^",3)!('+$P($G(^APCCCTRL(DUZ(2),11,PKG,0)),U,2)) D ;cmi/maw 9/1/09 orig line PATCH 1011
+5 ;cmi/maw 9/1/09 mod line PATCH 1011
IF $PIECE(^DG(40.8,$ORDER(^DG(40.8,"AD",DUZ(2),0)),0),"^",3)!('+$PIECE($GET(^APCCCTRL(DUZ(2),11,PKG,0)),U,2))
Begin DoDot:1
+6 WRITE !!,"Outpatient only site 'OR' PCC link not setup - visit not created"
+7 SET DFN=0
End DoDot:1
+8 IF '$TEST
Begin DoDot:1
+9 ;
+10 ;IHS/OIT/LJF 11/09/2005 PATCH 1004 prevent error in case of deletions
+11 ;S APCDALVR("APCDDATE")=+^ADGDS(DFN,"DS",DGDFN1,0) ;visit date
+12 ;visit date
SET APCDALVR("APCDDATE")=+$GET(^ADGDS(DFN,"DS",DGDFN1,0))
IF 'APCDALVR("APCDDATE")
QUIT
+13 ;
+14 ;check if visit already exists
+15 SET DGX=APCDALVR("APCDDATE")
SET DGX1=9999999-$PIECE(DGX,".")_"."_$PIECE(DGX,".",2)
+16 ;
+17 ;IHS/OIT/LJF 8/26/2005 PATCH 1004 reset date/time to checked in visit
DO FINDVST(.DGX1)
+18 ;
+19 IF $DATA(^AUPNVSIT("AA",DFN,DGX1))
Begin DoDot:2
+20 NEW A
SET A=0
+21 FOR
SET A=$ORDER(^AUPNVSIT("AA",DFN,DGX1,A))
IF A=""!(DFN<0)
QUIT
Begin DoDot:3
+22 ;visit found
IF $PIECE(^AUPNVSIT(A,0),U,7)="S"
SET DFN=DFN*-1
SET BDGDSVST=A
+23 WRITE !!,"Day Surgery VISIT was found..."
End DoDot:3
End DoDot:2
+24 IF DFN>0
Begin DoDot:2
+25 ; Visit not found, so create one
+26 ;initialize PCC variables
SET APCDALVR("APCDADD")=1
DO APCDEIN^ADGCALLS
+27 WRITE !!,"Day Surgery VISIT being created..."
+28 SET APCDALVR("APCDPAT")=DFN
SET APCDALVR("APCDLOC")=APCDDUZ2
+29 ;IHS/ITSC/WAR 4/14/04 Add Hosp Loc
+30 SET APCDALVR("APCDHL")=$$GET1^DIQ(9009020.1,1,.15,"I")
+31 ;IHS/ITSC/WAR 1/28/04 Mod to handle different types of Facilities
+32 ;S APCDALVR("APCDTYPE")="I",APCDALVR("APCDCAT")="S"
+33 SET APCDALVR("APCDTYPE")=$$GET1^DIQ(9001001.2,APCDALVR("APCDLOC"),.11,"I")
SET APCDALVR("APCDCAT")="S"
+34 ;IHS/OIT/LJF 05/04/2006 PATCH 1005
IF APCDALVR("APCDTYPE")=""
SET APCDALVR("APCDTYPE")=$$GET1^DIQ(9001000,DUZ(2),.04,"I")
+35 SET APCDALVR("APCDCLN")="DAY SURGERY"
DO DSCV^ADGCALLS
KILL AUPNSEX
+36 ;
+37 ;visit date
SET APCDALVR("APCDDATE")=+^ADGDS(DFN,"DS",DGDFN1,0)
+38 ;get visit entry
+39 SET DGX=APCDALVR("APCDDATE")
SET DGX1=9999999-$PIECE(DGX,".")_"."_$PIECE(DGX,".",2)
+40 KILL APCDALVR
+41 SET (BDGDSVST,FOUND)=0
+42 FOR
SET BDGDSVST=$ORDER(^AUPNVSIT("AA",DFN,DGX1,BDGDSVST))
IF BDGDSVST=""!(FOUND)
QUIT
Begin DoDot:3
+43 ;Day Surgery vst
IF $PIECE(^AUPNVSIT(BDGDSVST,0),U,7)="S"
Begin DoDot:4
+44 IF $PIECE(^AUPNVSIT(BDGDSVST,0),U,6)=DUZ(2)
SET FOUND=BDGDSVST
End DoDot:4
End DoDot:3
+45 SET BDGDSVST=FOUND
+46 IF +BDGDSVST=0
WRITE !!,*7,"VISIT ERROR, Please notify your supervisor!"
Begin DoDot:3
+47 SET DFN=0
End DoDot:3
End DoDot:2
+48 IF '$TEST
Begin DoDot:2
+49 ; reset the DFN to positive
SET DFN=DFN*-1
End DoDot:2
End DoDot:1
+50 QUIT
+51 ;
DSIC ;***> create incomplete chart entry
+1 ;IHS/ITSC/WAR 12/10/03 This section copied from BDGICEVT and modified
+2 ;
+3 SET (BDGICREC,X)=""
+4 FOR
SET X=$ORDER(^BDGIC("B",DFN,X))
IF X=""!(BDGICREC)
QUIT
Begin DoDot:1
+5 ;Check IC Disch date/time v.s. DaySurg Release date/time
+6 IF $PIECE(^BDGIC(X,0),U,2)=$PIECE(^ADGDS(DFN,"DS",DGDFN1,2),U,1)
SET BDGICREC=X
End DoDot:1
+7 IF +BDGICREC=0
Begin DoDot:1
+8 SET VST=BDGDSVST
+9 SET SERV=+$PIECE(^ADGDS(DFN,"DS",DGDFN1,0),U,5)
+10 SET SRDATE=DGX
+11 WRITE !!,"Creating entry in Incomplete Chart file....",!
KILL DIC
+12 ; make FM call to stuff data
+13 SET X=DFN
SET DIC="^BDGIC("
SET DLAYGO=9009016.1
SET DIC(0)="L"
+14 ; 4 slash visit to bypass file screen
+15 SET DIC("DR")=".03////"_VST_";.04///`"_SERV_";.05///"_(SRDATE\1)
+16 LOCK +^BDGIC(0):3
IF '$TEST
Begin DoDot:2
+17 IF $DATA(DGQUIET)
QUIT
+18 WRITE !,*7,"CANNOT ADD TO INCOMPLETE CHART FILE;"
+19 WRITE "BEING UPDATED BY SOMEONE ELSE"
End DoDot:2
End DoDot:1
+20 KILL DD,DO
DO FILE^DICN
LOCK -^BDGIC(0)
+21 KILL APCDALVR
+22 QUIT
+23 ;
LASTDS(BDGDT,DFN) ;EP; IP AdmDate and Pt being passed to this tag
+1 ;Get Pt's most recent DaySurg visit as it relates to IP Adm date
+2 ;Release date from DaySurg will be passed back in DSDATE
+3 ;If no release date entered yet, Admit date passed back in DSDATE
+4 SET DSDATE=0
+5 ;Pt has at least one entry
IF $GET(^ADGDS(DFN,0))
Begin DoDot:1
+6 SET BDGDT=$ORDER(^ADGDS(DFN,"DS","AA",BDGDT),-1)
+7 IF BDGDT'=""
Begin DoDot:2
+8 ;Get rec#
SET IEN=$ORDER(^ADGDS(DFN,"DS","AA",BDGDT,0))
+9 ;Get release date
IF IEN
SET DSDATE=+$GET(^ADGDS(DFN,"DS",IEN,2))
+10 ;Assumption - if NO release date entered yet
+11 ;return DaySurg ADMIT date
IF 'DSDATE
SET DSDATE=BDGDT
End DoDot:2
End DoDot:1
+12 QUIT DSDATE
+13 ;
DSPROC(BDGDT,DFN) ;IP AdmDate and Pt being passed to this tag
+1 ;Get free text PROCedure (if there)
+2 SET DSPROC=0
+3 ;Pt has at least one entry
IF $GET(^ADGDS(DFN,0))
Begin DoDot:1
+4 SET BDGDT=$ORDER(^ADGDS(DFN,"DS","AA",BDGDT),-1)
+5 IF BDGDT'=""
Begin DoDot:2
+6 ;Get rec#
SET IEN=$ORDER(^ADGDS(DFN,"DS","AA",BDGDT,0))
+7 IF +IEN
Begin DoDot:3
+8 ;Get release date
SET DSDATE=+$GET(^ADGDS(DFN,"DS",IEN,2))
+9 ;Get procedure
SET DSPROC=$PIECE($GET(^ADGDS(DFN,"DS",IEN,0)),U,2)
End DoDot:3
End DoDot:2
End DoDot:1
+10 QUIT DSPROC
+11 ;
DSDISP(DT,DFN) ;IP AdmDate and Pt being passed to this tag
+1 ;Get the DISPosition (if there) - none stored as of 3/4/04 WAR
+2 SET DSDISP=0
+3 ;
+4 ;
+5 QUIT DSDISP
+6 ;
+7 ;IHS/OIT/LJF 8/26/2005 PATCH 1004 new subroutine added
FINDVST(DATE) ; reset date/time to that for a day surgery visit if one exists
+1 ;temporary fix until day surgery rewrite
+2 NEW DATE1,IEN,FOUND
+3 SET FOUND=0
+4 ;take off time
SET DATE1=DATE\1
+5 FOR
SET DATE1=$ORDER(^AUPNVSIT("AA",DFN,DATE1))
IF 'DATE1
QUIT
IF ((DATE1\1)'=(DATE\1))
QUIT
IF FOUND
QUIT
Begin DoDot:1
+6 SET IEN=0
FOR
SET IEN=$ORDER(^AUPNVSIT("AA",DFN,DATE1,IEN))
IF 'IEN
QUIT
IF FOUND
QUIT
Begin DoDot:2
+7 IF $PIECE(^AUPNVSIT(IEN,0),U,7)="S"
SET FOUND=1
SET DATE=DATE1
End DoDot:2
End DoDot:1
+8 QUIT
