- 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
