source: WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SDAMEVT3.m@ 861

Last change on this file since 861 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 3.2 KB
Line 
1SDAMEVT3 ;ALB/CAW - Disposition Event Driver Utilities ; 11/2/00 8:40am
2 ;;5.3;Scheduling;**15,217**;Aug 13, 1993
3 ;
4BEFORE(DFN,SDDT,SDEVT,SDHDL) ;
5 D CAPTURE("BEFORE",.DFN,.SDDT,.SDEVT,.SDHDL)
6 Q
7 ;
8AFTER(DFN,SDDT,SDEVT,SDHDL) ;
9 N SDDA,SDIS,DA,DR,DE,DQ,DIV,DIE,SDVSIT,SDINS,SDIV,X
10 ;
11 S SDIS=$G(^DPT(DFN,"DIS",9999999-SDDT,0))
12 ; -- is the disposition good for opc credit?
13 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
14 .I SDEVT=9 W !!,*7,">>> This Disposition must be checked out."
15 .D RESET(DFN,9999999-SDDT,SDHDL)
16 .I $P(SDIS,U,18) D EN^SDCODEL($P(SDIS,U,18),1,SDHDL)
17 ;
18 ; -- is the disposition 'still' good for opc credit?
19 I $P(SDIS,U,2)'=0,$P(SDIS,U,2)'=1,$P(SDIS,U,18) D
20 .I '$$ASK D RESET(DFN,9999999-SDDT,SDHDL) Q
21 .D EN^SDCODEL($P(SDIS,U,18),1,SDHDL)
22 ;
23 ; -- capture 'after' data
24 D CAPTURE("AFTER",.DFN,.SDDT,.SDEVT,.SDHDL)
25 ;
26 ; -- has division changed
27 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
28 .;
29 .;-- is a new visit entry needed
30 .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
31 ..D ARRAY^SDVSIT(DFN,SDDT,.SDDA,.SDIS,.SDVSIT)
32 ..D VISIT^SDVSIT0(.SDDT,.SDVSIT)
33 ..I SDVSIT("VST") S DIE="^SCE(",DR=".05////"_SDVSIT("VST"),DA=SDOE D ^DIE
34 ..D OE^SDAMEVT("AFTER",3,SDOE,SDHDL)
35 ; If division has not changed AND patient has an Outpatient Encounter
36 ; display Hospital Disposition Location
37 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
38 .N PREVST,DIC,DA,DR,DIQ,DHL,Y,OK
39 .S OK=0
40 .S DIC="409.68",DR=".05",DA=SDOE,DIQ="PREVST(",DIQ(0)="I" D EN^DIQ1
41 .F D Q:OK=1 ; Get Disposition Hospital Location
42 ..S PREVST(0)=$G(PREVST("409.68",SDOE,".05","I"))
43 ..S DIC=9000010,DA=PREVST(0),DR=".22",DIQ="DHL(",DIQ(0)="EI" D EN^DIQ1
44 ..; Ask for Hospital location from those that can disposition
45 ..S DA(1)=1,DIC="^PX(815,1,""DHL"",",DIC("P")=$P(^DD(815,401,0),"^",2)
46 ..S DIC("B")=$G(DHL(9000010,PREVST(0),".22","E")) ; DHLocation
47 ..S DIC(0)="AEOQ" D ^DIC
48 ..I Y<0 W !!,$C(7),"Disposition Hospital Location is required." Q
49 ..S DR=".22////"_$P(Y,"^",2),DIE=9000010,DA=PREVST(0)
50 ..D ^DIE
51 ..S OK=1
52 Q
53 ;
54RESET(DFN,SDIDT,SDHDL) ;Reset Disposition Status
55 N DA,DE,DQ,DIE,DR,SDOSTA
56 S SDOSTA=$P($G(^TMP("SDEVT",$J,SDHDL,3,"DIS",0,"BEFORE")),"^",2)
57 I $G(SDOSTA)]"" D
58 .W !!,">>> Changing status back to ",$P($P(^DD(2.101,1,0),SDOSTA_":",2),";"),"..."
59 .S DA=SDIDT,DA(1)=DFN,DR="1////"_SDOSTA
60 .S DIE="^DPT("_DFN_",""DIS""," D ^DIE
61 .W "done"
62 Q
63 ;
64ASK() ;Ask if user is sure they want to change the disposition status
65 N DIR,DTOUT,DUOUT,Y
66 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."
67 S DIR("A")="Are you sure you want to change the status"
68 S DIR("B")="NO",DIR(0)="Y" W ! D ^DIR
69 Q +$G(Y)
70 ;
71CAPTURE(SDCAP,DFN,SDDT,SDEVT,SDHDL) ;
72 N SDDA,Z
73 S SDDA=9999999-SDDT
74 S (Z,^TMP("SDEVT",$J,SDHDL,3,"DIS",0,SDCAP))=$G(^DPT(DFN,"DIS",SDDA,0))
75 D:$P(Z,U,18) OE^SDAMEVT(SDCAP,3,+$P(Z,U,18),SDHDL)
76 Q
77 ;
78EVT(DFN,SDDT,SDEVT,SDHDL) ;
79 D AFTER(.DFN,.SDDT,.SDEVT,SDHDL)
80 D EVTGO^SDAMEVT2
81 Q
Note: See TracBrowser for help on using the repository browser.