source: WorldVistAEHR/trunk/r/PCE_PATIENT_CARE_ENCOUNTER-AUTN-EFDP-PX-VSIT--PXRM/PXUTLSTP.m@ 975

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

initial load of WorldVistAEHR

File size: 3.6 KB
Line 
1PXUTLSTP ;ISL/dee,ESW - Utility routine used by PCE to add/edit/delete stop code visits ; 7/25/03 4:12pm
2 ;;1.0;PCE PATIENT CARE ENCOUNTER;**1,96,166**;Aug 12, 1996
3 Q
4 ;
5STOPCODE(PXUTSOR,PXUTSTOP,PXUTVST,PXUTSVST) ;Makes or edits visit to create the secondary visit for the credit stops
6 ; Parameters
7 ; PXUTSOR IEN of the Data source
8 ; PXUTSTOP Pointer to Stop Code if "@" the delete the secondary visit
9 ; PXUTVST Main visit
10 ; PXUTSVST Secondary visit
11 ; if there is not one then create one
12 ; if there is one then this is an edit or delete
13 ;
14 ; Returns the pointer to the secondary visit
15 ; or 0 if the secondary visit was deleted,
16 ; or null if visit tracking did not create the visit.
17 ;
18 D EVENT^PXKMAIN
19 N PXUAFTER,PXUTNODE,PXUTRET,PXKERROR,PXUTEXIT
20 K ^TMP("PXK",$J)
21 S PXUTEXIT=0
22 ;
23 I $G(PXUTSVST)>0 D Q:PXUTEXIT -1
24 . L +^AUPNVSIT(PXUTSVST):5 E W !!,$C(7),"Cannot edit at this time, try again later." D PAUSE^PXCEHELP S PXUTEXIT=1 Q
25 . I PXUTSTOP="@" D
26 ..;--ENTERED TO TRY TO KILL STOP CODES
27DELETE ..;If stop code has to be killed on credit stop code visit then
28 ..; the whole visit has to be killed with and pointing to it
29 ..; outpatient encounter.
30 .. F PXUTNODE=0,21,150,800,811,812 D
31 ... S (^TMP("PXK",$J,"VST",1,PXUTNODE,"AFTER"),^TMP("PXK",$J,"VST",1,PXUTNODE,"BEFORE"))=$G(^AUPNVSIT(PXUTSVST,PXUTNODE))
32 .. S $P(^TMP("PXK",$J,"VST",1,0,"AFTER"),"^",8)="@"
33 .. S ^TMP("PXK",$J,"VST",1,"IEN")=PXUTSVST
34 ..; Verify if this is really credit stop visit with only 1 dependent
35 ..; entry that is outpatient encounter.
36 .. I $$DEC^VSITKIL(PXUTSVST,0)<2,$P($G(^AUPNVSIT(PXUTSVST,150)),U,3)="C" D ;PX/96
37 ... S ^TMP("PXK",$J,"VST",1,0,"AFTER")="@"
38 ...; Find Outpatient Encounter to take care of
39 ... N SDOEP
40 ... D LISTVST^SDOERPC(.SDOEP,PXUTVST)
41 ... S SDOEP=$P(SDOEP,")")_","_""""""_")"
42 ... S SDOEP=$O(@SDOEP) D CHLD^SDCODEL(SDOEP,0)
43 . E D
44EDIT .. F PXUTNODE=0,21,150,800,811,812 D
45 ... S (^TMP("PXK",$J,"VST",1,PXUTNODE,"AFTER"),^TMP("PXK",$J,"VST",1,PXUTNODE,"BEFORE"))=$G(^AUPNVSIT(PXUTSVST,PXUTNODE))
46 .. S $P(^TMP("PXK",$J,"VST",1,0,"AFTER"),"^",8)=PXUTSTOP
47 .. S ^TMP("PXK",$J,"VST",1,"IEN")=PXUTSVST
48 ;
49 E I $G(PXUTVST)>0 D
50CREATE . F PXUTNODE=150,800,811 D
51 .. S ^TMP("PXK",$J,"VST",1,PXUTNODE,"AFTER")=""
52 .. S ^TMP("PXK",$J,"VST",1,PXUTNODE,"BEFORE")=""
53 . S ^TMP("PXK",$J,"VST",1,21,"AFTER")=$G(^AUPNVSIT(PXUTVST,21))
54 . S ^TMP("PXK",$J,"VST",1,21,"BEFORE")=""
55 . S ^TMP("PXK",$J,"VST",1,150,"AFTER")="^^S"
56 . S ^TMP("PXK",$J,"VST",1,150,"BEFORE")=""
57 . S ^TMP("PXK",$J,"VST",1,812,"AFTER")="^^"_PXUTSOR
58 . S ^TMP("PXK",$J,"VST",1,812,"BEFORE")=""
59 . S PXUAFTER=$G(^AUPNVSIT(PXUTVST,0))
60 . S ^TMP("PXK",$J,"VST",1,0,"AFTER")=$P(PXUAFTER,"^",1)_"^^^^"_$P(PXUAFTER,"^",5,6)_"^^"_PXUTSTOP_"^^^^"_PXUTVST_"^^^^^^^^^"_$P(PXUAFTER,"^",21,22)
61 . S ^TMP("PXK",$J,"VST",1,0,"BEFORE")=""
62 . S ^TMP("PXK",$J,"VST",1,"IEN")=""
63 E Q -1
64 ;
65 S ^TMP("PXK",$J,"SOR")=PXUTSOR
66 D EN1^PXKMAIN
67 S PXUTRET=^TMP("PXK",$J,"VST",1,"IEN")
68 D EVENT^PXKMAIN
69 K ^TMP("PXK",$J)
70 I PXUTRET>0,$G(PXUTSVST)>0,PXUTSTOP="@" D
71 . N PXUTKILL
72 . S PXUTKILL=$$KILL^VSITKIL(PXUTSVST)
73 . S:'PXUTKILL PXUTRET=0
74 I $G(PXUTSVST)>0 L -^AUPNVSIT(PXUTSVST):5
75 D MODIFIED^VSIT(PXUTVST)
76 Q PXUTRET
77 ;
78 ;
79 ;
80 ;
81DEAD(VSIT) ;---*** ADDED IN ALBANY BY VAUGHN
82 ;--TO KILL LEFT OVER CREDIT STOP ENTRY THAT IS NOT DELETED
83 ;-added next line to quit
84 Q:$G(VSIT)<1
85 N DEAD,CHILD
86 S CHILD=0 F S CHILD=$O(^AUPNVSIT("AD",VSIT,CHILD)) Q:CHILD="" D
87 .I $P($G(^AUPNVSIT(CHILD,0)),"^",8)="",$P($G(^AUPNVSIT(CHILD,0)),"^",9)<1,$P($G(^AUPNVSIT(CHILD,150)),"^",3)="C" S DEAD=$$KILL^VSITKIL(CHILD)
88 ;-----END OF ADDED CODE VAUGHN----
89 ;
Note: See TracBrowser for help on using the repository browser.