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

SDAMEVT3.m

Go to the documentation of this file. 
  1. SDAMEVT3 ;ALB/CAW - Disposition Event Driver Utilities ; 11/2/00 8:40am
  1.  ;;5.3;Scheduling;**15,217,1015**;Aug 13, 1993;Build 21
  1.  ;
  1. BEFORE(DFN,SDDT,SDEVT,SDHDL) ;
  1.  D CAPTURE("BEFORE",.DFN,.SDDT,.SDEVT,.SDHDL)
  1.  Q
  1.  ;
  1. AFTER(DFN,SDDT,SDEVT,SDHDL) ;
  1.  N SDDA,SDIS,DA,DR,DE,DQ,DIV,DIE,SDVSIT,SDINS,SDIV,X
  1.  ;
  1.  S SDIS=$G(^DPT(DFN,"DIS",9999999-SDDT,0))
  1.  ; -- is the disposition good for opc credit?
  1.  I ($P(SDIS,U,2)=0!($P(SDIS,U,2)=1)),$P(SDIS,U,6),'$P($G(^SCE(+$P(SDIS,U,18),0)),U,7) D
  1.  .I SDEVT=9 W !!,*7,">>> This Disposition must be checked out."
  1.  .D RESET(DFN,9999999-SDDT,SDHDL)
  1.  .I $P(SDIS,U,18) D EN^SDCODEL($P(SDIS,U,18),1,SDHDL)
  1.  ;
  1.  ; -- is the disposition 'still' good for opc credit?
  1.  I $P(SDIS,U,2)'=0,$P(SDIS,U,2)'=1,$P(SDIS,U,18) D
  1.  .I '$$ASK D RESET(DFN,9999999-SDDT,SDHDL) Q
  1.  .D EN^SDCODEL($P(SDIS,U,18),1,SDHDL)
  1.  ;
  1.  ; -- capture 'after' data
  1.  D CAPTURE("AFTER",.DFN,.SDDT,.SDEVT,.SDHDL)
  1.  ;
  1.  ; -- has division changed
  1.  I $P(^TMP("SDEVT",$J,SDHDL,3,"DIS",0,"BEFORE"),U,4)'=$P(^("AFTER"),U,4) S X=^("AFTER") I $P(X,U,18) S SDIV=$P(X,U,4),SDOE=$P(X,U,18) D  Q
  1.  .;
  1.  .;-- is a new visit entry needed
  1.  .I $P($G(^AUPNVSIT(+$P($G(^SCE(SDOE,0)),U,5),0)),U,6) S SDINS=$P(^(0),U,6) I SDINS'=$P($G(^DG(40.8,SDIV,0)),U,7) D
  1.  ..D ARRAY^SDVSIT(DFN,SDDT,.SDDA,.SDIS,.SDVSIT)
  1.  ..D VISIT^SDVSIT0(.SDDT,.SDVSIT)
  1.  ..I SDVSIT("VST") S DIE="^SCE(",DR=".05////"_SDVSIT("VST"),DA=SDOE D ^DIE
  1.  ..D OE^SDAMEVT("AFTER",3,SDOE,SDHDL)
  1.  ; If division has not changed AND patient has an Outpatient Encounter
  1.  ; display Hospital Disposition Location
  1.  S X=$G(^TMP("SDEVT",$J,SDHDL,3,"DIS",0,"AFTER")) I $P(X,U,18) S SDIV=$P(X,U,4),SDOE=$P(X,U,18) D
  1.  .N PREVST,DIC,DA,DR,DIQ,DHL,Y,OK
  1.  .S OK=0
  1.  .S DIC="409.68",DR=".05",DA=SDOE,DIQ="PREVST(",DIQ(0)="I" D EN^DIQ1
  1.  .F  D  Q:OK=1  ; Get Disposition Hospital Location
  1.  ..S PREVST(0)=$G(PREVST("409.68",SDOE,".05","I"))
  1.  ..S DIC=9000010,DA=PREVST(0),DR=".22",DIQ="DHL(",DIQ(0)="EI" D EN^DIQ1
  1.  ..; Ask for Hospital location from those that can disposition
  1.  ..S DA(1)=1,DIC="^PX(815,1,""DHL"",",DIC("P")=$P(^DD(815,401,0),"^",2)
  1.  ..S DIC("B")=$G(DHL(9000010,PREVST(0),".22","E")) ; DHLocation
  1.  ..S DIC(0)="AEOQ" D ^DIC
  1.  ..I Y<0 W !!,$C(7),"Disposition Hospital Location is required." Q
  1.  ..S DR=".22////"_$P(Y,"^",2),DIE=9000010,DA=PREVST(0)
  1.  ..D ^DIE
  1.  ..S OK=1
  1.  Q
  1.  ;
  1. RESET(DFN,SDIDT,SDHDL) ;Reset Disposition Status
  1.  N DA,DE,DQ,DIE,DR,SDOSTA
  1.  S SDOSTA=$P($G(^TMP("SDEVT",$J,SDHDL,3,"DIS",0,"BEFORE")),"^",2)
  1.  I $G(SDOSTA)]"" D
  1.  .W !!,">>> Changing status back to ",$P($P(^DD(2.101,1,0),SDOSTA_":",2),";"),"..."
  1.  .S DA=SDIDT,DA(1)=DFN,DR="1////"_SDOSTA
  1.  .S DIE="^DPT("_DFN_",""DIS""," D ^DIE
  1.  .W "done"
  1.  Q
  1.  ;
  1. ASK() ;Ask if user is sure they want to change the disposition status
  1.  N DIR,DTOUT,DUOUT,Y
  1.  W !!,*7,">>> Changing the status of this disposition will delete any check out",!?4,"related information.  This information may include add/edits,",!?4,"classifications, providers and diagnoses."
  1.  S DIR("A")="Are you sure you want to change the status"
  1.  S DIR("B")="NO",DIR(0)="Y" W ! D ^DIR
  1.  Q +$G(Y)
  1.  ;
  1. CAPTURE(SDCAP,DFN,SDDT,SDEVT,SDHDL) ;
  1.  N SDDA,Z
  1.  S SDDA=9999999-SDDT
  1.  S (Z,^TMP("SDEVT",$J,SDHDL,3,"DIS",0,SDCAP))=$G(^DPT(DFN,"DIS",SDDA,0))
  1.  D:$P(Z,U,18) OE^SDAMEVT(SDCAP,3,+$P(Z,U,18),SDHDL)
  1.  Q
  1.  ;
  1. EVT(DFN,SDDT,SDEVT,SDHDL) ;
  1.  D AFTER(.DFN,.SDDT,.SDEVT,SDHDL)
  1.  D EVTGO^SDAMEVT2
  1.  Q