ADGDSA ; IHS/ADC/PDW/ENM - DAY SURGERY ENTER/EDIT ; [ 09/17/2002 3:55 PM ]
;;5.0;ADMISSION/DISCHARGE/TRANSFER;;MAR 25, 1999
;
;***> get patient
NAME W !! K DFN 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") G END:X="",END:X=U,NAME:Y<0
;
S (DFN,DA)=+Y D EN^ADGPI ;print patient inquiry info
I $D(^DPT(DFN,.35)),$P(^(.35),U)]"" D G NAME:Y=0
. K DIR S DIR(0)="Y"
. S DIR("A")="This patient has died. Sure you want to continue"
. S DIR("B")="NO" D ^DIR
;
;***> get day surgery date
DSDATE 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)
G DSASK:DGA="",DSASK:'$O(^ADGDS(DFN,"DS",0))
S DIC("B")=$S('$D(^ADGDS(DFN,"DS",DGA,2)):DGA,$P(^(2),U)="":DGA,1:"")
;
DSASK L +^ADGDS(DFN,"DS"):3 I '$T D G NAME
. W !,*7,"SOMEONE ELSE IS UPDATING THIS DAY SURGERY PATIENT; TRY AGAIN LATER"
D ^DIC L -^ADGDS(DFN,"DS") W !! K DIC,DIC("A") G NAME:Y'>0 S DGDFN1=+Y
I $D(^ADGDS(DFN,"DS",DGDFN1,2)),$P(^(2),U)'="" W !?5,*7,"Past day surgeries must be edited in the Edit Past Day Surgery option",! G DSDATE
;
;***> enter/edit using input template
L +^ADGDS(DFN):3 I '$T D G DSDATE
. W !,*7,"SOMEONE IS UPDATING THIS ENTRY; TRY AGAIN LATER"
S DIDEL=9009012,DR="[ADGDSADD]",DIE="^ADGDS(",DA=DFN
S DIE("NO^")="" D ^DIE L -^ADGDS(DFN) K DIE("NO^")
;
;***> print day surgery worksheet
CRB 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 S ADGDFN=DFN,ADGDFN1=DGDFN1 D DS1^ADGCRB0 S DFN=ADGDFN,DGDFN1=ADGDFN1 ;go to print
;
;***> go back & ask for another patient if no release date/time entered
G NAME:'$D(^ADGDS(DFN,"DS",DGDFN1,2)),NAME:$P(^(2),U)=""
;
DSIC ;***> create incomplete chart entry
W !!,"Creating entry in DS Incomplete Chart file....",! K DIC
INC I '$D(^ADGDSI(DFN,0))#2 S X="`"_DFN,DIC="^ADGDSI(",DLAYGO=9009012,DIC(0)="L" D ^DIC
I '$D(^ADGDSI(DFN,0))#2 G VST
S:'$D(^ADGDSI(DFN,"DT",0)) ^ADGDSI(DFN,"DT",0)="^9009012.51D^^"
S X=+^ADGDS(DFN,"DS",DGDFN1,0),DGSRV=$P(^(0),U,5),DA(1)=DFN
S DA=$P(^ADGDSI(DFN,"DT",0),U,3)+1
S DIC="^ADGDSI("_DFN_",""DT"",",DLAYGO=9009012,DIC(0)="L"
L +^ADGDSI(DFN):3 I '$T D G VST
. W !,*7,"CANNOT ADD TO DS INCOMPLETE CHART FILE; BEING UPDATED BY SOMEONE ELSE"
D ^DIC L -^ADGDSI(DFN)
S DIE=DIC,DA=$P(^ADGDSI(DFN,"DT",0),U,3),DR="5///^S X=""`""_DGSRV" D ^DIE K DIC,DIE
;
VST ;***> create visit in PCC for day surgery
I '$D(^DG(43,1,9999999))!($P(^DG(43,1,9999999),U,2)'="Y") G END
S APCDALVR("APCDDATE")=+^ADGDS(DFN,"DS",DGDFN1,0) ;visit date
;check if visit already exists
S DGX=APCDALVR("APCDDATE"),DGX1=9999999-$P(DGX,".")_"."_$P(DGX,".",2)
G NAME:$D(^AUPNVSIT("AA",DFN,DGX1))
;
S APCDALVR("APCDADD")=1 D APCDEIN^ADGCALLS ;initialize PCC variables
W !!,"Day Surgery visit being created..."
S APCDALVR("APCDPAT")=DFN,APCDALVR("APCDLOC")=APCDDUZ2
S APCDALVR("APCDTYPE")="I",APCDALVR("APCDCAT")="S"
S APCDALVR("APCDCLN")="DAY SURGERY" D DSCV^ADGCALLS K AUPNSEX
I $D(APCDALVR("APCDAFLG")) W !!,*7,"VISIT ERROR, Please notify your supervisor!" G END
V9 K APCDALVR G NAME
;
END D KILL^ADGUTIL K ADGDFN,ADGDFN1 Q
ADGDSA ; IHS/ADC/PDW/ENM - DAY SURGERY ENTER/EDIT ; [ 09/17/2002 3:55 PM ]
+1 ;;5.0;ADMISSION/DISCHARGE/TRANSFER;;MAR 25, 1999
+2 ;
+3 ;***> get patient
NAME WRITE !!
KILL DFN
SET DIC=9009012
SET DLAYGO=9009012
SET DIC(0)="AQEML"
+1 SET DIC("A")="Select Day Surgery Patient: "
+2 ;set DIC("S") to check for unregistered patients
+3 SET DIC("S")="I $D(^AUPNPAT(+Y,41,DUZ(2),0)),$P(^(0),U,2)'="""""
+4 DO ^DIC
KILL DIC("A")
IF X=""
GOTO END
IF X=U
GOTO END
IF Y<0
GOTO NAME
+5 ;
+6 ;print patient inquiry info
SET (DFN,DA)=+Y
DO EN^ADGPI
+7 IF $DATA(^DPT(DFN,.35))
IF $PIECE(^(.35),U)]""
Begin DoDot:1
+8 KILL DIR
SET DIR(0)="Y"
+9 SET DIR("A")="This patient has died. Sure you want to continue"
+10 SET DIR("B")="NO"
DO ^DIR
End DoDot:1
IF Y=0
GOTO NAME
+11 ;
+12 ;***> get day surgery date
DSDATE KILL DIC
IF '$DATA(^ADGDS(DFN,"DS",0))
SET ^(0)="^9009012.01D^^"
+1 SET DIC="^ADGDS("_DFN_",""DS"","
SET DLAYGO=9009012
SET DIC(0)="AEQMZL"
+2 SET DA(1)=DFN
SET DA=0
SET DGA=$PIECE(^ADGDS(DFN,"DS",0),U,3)
+3 IF DGA=""
GOTO DSASK
IF '$ORDER(^ADGDS(DFN,"DS",0))
GOTO DSASK
+4 SET DIC("B")=$SELECT('$DATA(^ADGDS(DFN,"DS",DGA,2)):DGA,$PIECE(^(2),U)="":DGA,1:"")
+5 ;
DSASK LOCK +^ADGDS(DFN,"DS"):3
IF '$TEST
Begin DoDot:1
+1 WRITE !,*7,"SOMEONE ELSE IS UPDATING THIS DAY SURGERY PATIENT; TRY AGAIN LATER"
End DoDot:1
GOTO NAME
+2 DO ^DIC
LOCK -^ADGDS(DFN,"DS")
WRITE !!
KILL DIC,DIC("A")
IF Y'>0
GOTO NAME
SET DGDFN1=+Y
+3 IF $DATA(^ADGDS(DFN,"DS",DGDFN1,2))
IF $PIECE(^(2),U)'=""
WRITE !?5,*7,"Past day surgeries must be edited in the Edit Past Day Surgery option",!
GOTO DSDATE
+4 ;
+5 ;***> enter/edit using input template
+6 LOCK +^ADGDS(DFN):3
IF '$TEST
Begin DoDot:1
+7 WRITE !,*7,"SOMEONE IS UPDATING THIS ENTRY; TRY AGAIN LATER"
End DoDot:1
GOTO DSDATE
+8 SET DIDEL=9009012
SET DR="[ADGDSADD]"
SET DIE="^ADGDS("
SET DA=DFN
+9 SET DIE("NO^")=""
DO ^DIE
LOCK -^ADGDS(DFN)
KILL DIE("NO^")
+10 ;
+11 ;***> print day surgery worksheet
CRB KILL DIR
SET DIR("A")="Print Day Surgery Worksheet"
SET DIR(0)="Y"
+1 SET DIR("?")="Enter YES to print a worksheet for this patient"
+2 SET DIR("B")="NO"
DO ^DIR
+3 ;go to print
IF Y=1
SET ADGDFN=DFN
SET ADGDFN1=DGDFN1
DO DS1^ADGCRB0
SET DFN=ADGDFN
SET DGDFN1=ADGDFN1
+4 ;
+5 ;***> go back & ask for another patient if no release date/time entered
+6 IF '$DATA(^ADGDS(DFN,"DS",DGDFN1,2))
GOTO NAME
IF $PIECE(^(2),U)=""
GOTO NAME
+7 ;
DSIC ;***> create incomplete chart entry
+1 WRITE !!,"Creating entry in DS Incomplete Chart file....",!
KILL DIC
INC IF '$DATA(^ADGDSI(DFN,0))#2
SET X="`"_DFN
SET DIC="^ADGDSI("
SET DLAYGO=9009012
SET DIC(0)="L"
DO ^DIC
+1 IF '$DATA(^ADGDSI(DFN,0))#2
GOTO VST
+2 IF '$DATA(^ADGDSI(DFN,"DT",0))
SET ^ADGDSI(DFN,"DT",0)="^9009012.51D^^"
+3 SET X=+^ADGDS(DFN,"DS",DGDFN1,0)
SET DGSRV=$PIECE(^(0),U,5)
SET DA(1)=DFN
+4 SET DA=$PIECE(^ADGDSI(DFN,"DT",0),U,3)+1
+5 SET DIC="^ADGDSI("_DFN_",""DT"","
SET DLAYGO=9009012
SET DIC(0)="L"
+6 LOCK +^ADGDSI(DFN):3
IF '$TEST
Begin DoDot:1
+7 WRITE !,*7,"CANNOT ADD TO DS INCOMPLETE CHART FILE; BEING UPDATED BY SOMEONE ELSE"
End DoDot:1
GOTO VST
+8 DO ^DIC
LOCK -^ADGDSI(DFN)
+9 SET DIE=DIC
SET DA=$PIECE(^ADGDSI(DFN,"DT",0),U,3)
SET DR="5///^S X=""`""_DGSRV"
DO ^DIE
KILL DIC,DIE
+10 ;
VST ;***> create visit in PCC for day surgery
+1 IF '$DATA(^DG(43,1,9999999))!($PIECE(^DG(43,1,9999999),U,2)'="Y")
GOTO END
+2 ;visit date
SET APCDALVR("APCDDATE")=+^ADGDS(DFN,"DS",DGDFN1,0)
+3 ;check if visit already exists
+4 SET DGX=APCDALVR("APCDDATE")
SET DGX1=9999999-$PIECE(DGX,".")_"."_$PIECE(DGX,".",2)
+5 IF $DATA(^AUPNVSIT("AA",DFN,DGX1))
GOTO NAME
+6 ;
+7 ;initialize PCC variables
SET APCDALVR("APCDADD")=1
DO APCDEIN^ADGCALLS
+8 WRITE !!,"Day Surgery visit being created..."
+9 SET APCDALVR("APCDPAT")=DFN
SET APCDALVR("APCDLOC")=APCDDUZ2
+10 SET APCDALVR("APCDTYPE")="I"
SET APCDALVR("APCDCAT")="S"
+11 SET APCDALVR("APCDCLN")="DAY SURGERY"
DO DSCV^ADGCALLS
KILL AUPNSEX
+12 IF $DATA(APCDALVR("APCDAFLG"))
WRITE !!,*7,"VISIT ERROR, Please notify your supervisor!"
GOTO END
V9 KILL APCDALVR
GOTO NAME
+1 ;
END DO KILL^ADGUTIL
KILL ADGDFN,ADGDFN1
QUIT
