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

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

initial load of WorldVistAEHR
File size: 4.9 KB
Line 
1PXCEVFI4 ;ISL/dee - Routine to display a visit or v-file entry and input providers in to V PROVIDER from other V Files ;6/20/96
2 ;;1.0;PCE PATIENT CARE ENCOUNTER;**124**;Aug 12, 1996
3 Q
4DISPLAY ; -- display the data
5 Q:PXCECAT="CSTP"
6 N PXCELINE,PXCETEXT,PXCEINT,PXCEEXT
7 I PXCECAT="APPM"!(PXCECAT="HIST") N PXCECODE S PXCECODE="PXCESIT"
8 W !
9 F PXCELINE=1:1 S PXCETEXT=$P($T(FORMAT+PXCELINE^@PXCECODE),";;",2) Q:PXCETEXT']"" D
10 . S (PXCEINT,PXCEEXT)=$P(PXCEAFTR($P(PXCETEXT,"~",1)),"^",$P(PXCETEXT,"~",2))
11 . I PXCEINT="@" S PXCEEXT="<deleted>"
12 . E I PXCEINT'="" D
13 .. I $P(PXCETEXT,"~",6)]"" S @("PXCEEXT="_$P(PXCETEXT,"~",6)_"("""_PXCEINT_""")")
14 .. E D
15 ... N DIERR,PXCEDILF
16 ... S PXCEEXT=$$EXTERNAL^DILFD(PXCEFILE,$P(PXCETEXT,"~",3),"",PXCEINT,"PXCEDILF")
17 ... S PXCEEXT=$S('$D(DIERR):PXCEEXT,1:PXCEINT)
18 . I ($L($P(PXCETEXT,"~",5))+$L(PXCEEXT))'>80 D
19 .. W !,$P(PXCETEXT,"~",5),PXCEEXT
20 . E D
21 .. N PXCEWRAP,PXCECOUN
22 .. D WRAP(PXCEEXT,80-$L($P(PXCETEXT,"~",5)),.PXCEWRAP)
23 .. W !,$P(PXCETEXT,"~",5),$G(PXCEWRAP(1))
24 .. S PXCECOUN=1
25 .. F S PXCECOUN=$O(PXCEWRAP(PXCECOUN)) Q:PXCECOUN']"" D
26 ... W !,$J("",$L($P(PXCETEXT,"~",5))),PXCEWRAP(PXCECOUN)
27 Q
28 ;
29WRAP(X,DIWR,WRAPPED) ;Copies the text in X into the array WRAPPED
30 N DIWL,DIWF,PXCEINDX
31 K ^UTILITY($J,"W")
32 S DIWL=1
33 S DIRF=""
34 D ^DIWP
35 S PXCEINDX=0
36 F S PXCEINDX=$O(^UTILITY($J,"W",DIWL,PXCEINDX)) Q:'PXCEINDX S WRAPPED(PXCEINDX)=^UTILITY($J,"W",DIWL,PXCEINDX,0)
37 K ^UTILITY($J,"W")
38 Q
39 ;
40PROVIDER(PXCEPRV) ;See if it is a new provider and if it is add them.
41 N PXCEVPRV,PXCEKPRV,PXCENPRV,PXCEPRIM
42 N DIR,DA,X,Y
43 S (PXCEVPRV,PXCEKPRV)=""
44 S PXCEPRIM=0
45 ;See if this provider is already in V Provider for this Encounter
46 F S PXCEVPRV=$O(^AUPNVPRV("AD",PXCEVIEN,PXCEVPRV)) Q:PXCEVPRV'>0 Q:PXCEPRV=$P(^AUPNVPRV(PXCEVPRV,0),"^",1) S:"P"=$P(^AUPNVPRV(PXCEVPRV,0),"^",4) PXCEPRIM=1
47 Q:PXCEVPRV>0
48 ;See if this provider is in the ^TMP("PXK",$J,
49 F S PXCEKPRV=$O(^TMP("PXK",$J,"PRV",PXCEKPRV)) Q:PXCEKPRV'>0 Q:PXCEPRV=+^TMP("PXK",$J,"PRV",PXCEKPRV,0,"AFTER") S:"P"=$P(^TMP("PXK",$J,"PRV",PXCEKPRV,0,"AFTER"),"^",4) PXCEPRIM=1
50 Q:PXCEKPRV>0
51 I 'PXCEPRIM D I $D(DTOUT)!$D(DUOUT) Q
52 . N DIR,DA
53 . S DIR(0)="9000010.06,.04A"
54 . S DIR("A")="Is this provider Primary or Secondary? "
55 . S DIR("B")=$S(PXCEPRIM:"S",1:"P")
56 . D ^DIR
57 I PXCEPRIM S Y="S"
58 ;Set PXCENPRV to the next provider in ^TMP("PXK",$J,"PRV",
59 I $Q(^TMP("PXK",$J,"PRV"))["PXK,"_$J_",PRV" S PXCENPRV=+$O(^TMP("PXK",$J,"PRV",""),-1)+1
60 E S PXCENPRV=1
61 S ^TMP("PXK",$J,"PRV",PXCENPRV,"IEN")=""
62 S ^TMP("PXK",$J,"PRV",PXCENPRV,0,"BEFORE")=""
63 S ^TMP("PXK",$J,"PRV",PXCENPRV,0,"AFTER")=PXCEPRV_"^"_PXCEPAT_"^"_PXCEVIEN_"^"_$P(Y,"^")
64 S ^TMP("PXK",$J,"PRV",PXCENPRV,812,"BEFORE")=""
65 S ^TMP("PXK",$J,"PRV",PXCENPRV,812,"AFTER")="^"_PXCEPKG_"^"_PXCESOR
66 Q
67 ;
68DIAGNOS(PXCEPOV) ;See if it is a new diagnosis and if it is add them.
69 N PXCEVPOV,PXCEKPOV,PXCENPOV,PXCEPMSC,PXCENARR,PXCEMOD,PXCEDXSC,PXCEX,PXCEY
70 N DIR,DA,X,Y
71 S (PXCEVPOV,PXCEKPOV)=""
72 S PXCEPRIM=0
73 ;See if this diagnosis is already in V POV for this Encounter
74 F S PXCEVPOV=$O(^AUPNVPOV("AD",PXCEVIEN,PXCEVPOV)) Q:PXCEVPOV'>0 Q:PXCEPOV=$P(^AUPNVPOV(PXCEVPOV,0),"^",1) S:"P"=$P(^AUPNVPOV(PXCEVPOV,0),"^",12) PXCEPRIM=1
75 Q:PXCEVPOV>0
76 ;See if this diagnosis is in the ^TMP("PXK",$J,
77 F S PXCEKPOV=$O(^TMP("PXK",$J,"POV",PXCEKPOV)) Q:PXCEKPOV'>0 Q:PXCEPOV=+^TMP("PXK",$J,"POV",PXCEKPOV,0,"AFTER") S:"P"=$P(^TMP("PXK",$J,"POV",PXCEKPOV,0,"AFTER"),"^",12) PXCEPRIM=1
78 Q:PXCEKPOV>0
79 ;Is this diagnosis primary P/S
80 I 'PXCEPRIM D I $D(DTOUT)!$D(DUOUT) S PXCEEND=1,PXCEQUIT=1 Q
81 . N DIR,DA
82 . S DIR(0)="9000010.07,.12A"
83 . S DIR("A")="Diagnosis is Primary? "
84 . S DIR("B")="P"
85 . D ^DIR
86 . S PXCEPMSC=$P(Y,"^",1)
87 . S:PXCEPMSC="P" PXCEPRIM=1
88 S:'$D(PXCEPMSC) PXCEPMSC="S"
89 ;Diagnosis narrative
90 D I $D(DTOUT)!$D(DUOUT) S PXCEEND=1,PXCEQUIT=1 Q
91 . N DIR,DA
92 . S DIR(0)="9000010.07,.04AO"
93 . S DIR("A")="Provider Narrative: "
94 . D ^DIR
95 S PXCEX=Y
96 I PXCEX="" S PXCEX=$$EXTTEXT^PXUTL1(+PXCEPOV,1,80,10,3)
97 W !,PXCEX
98 S PXCEY=$$PROVNARR^PXAPI(PXCEX,9000010.07) I +PXCEY'>0 W "??",$C(7) S PXCEEND=1,PXCEQUIT=1 Q
99 S PXCENARR=$P(PXCEY,"^",1)
100 ;Diagnosis modifier
101 D I $D(DTOUT)!$D(DUOUT) S PXCEEND=1,PXCEQUIT=1 Q
102 . N DIR,DA
103 . S DIR(0)="9000010.07,.06A"
104 . S DIR("A")="Diagnosis Modifier: "
105 . D ^DIR
106 S PXCEMOD=$P(Y,U,2)
107 ;Diagnosis Service Connected, Clinical Indicators
108 D GET800^PXCED800
109 ;Set PXCENPOV to the next diagnosis in ^TMP("PXK",$J,"POV",
110 I $Q(^TMP("PXK",$J,"POV"))["PXK,"_$J_",POV" S PXCENPOV=+$O(^TMP("PXK",$J,"POV",""),-1)+1
111 E S PXCENPOV=1
112 S ^TMP("PXK",$J,"POV",PXCENPOV,"IEN")=""
113 S ^TMP("PXK",$J,"POV",PXCENPOV,0,"BEFORE")=""
114 S ^TMP("PXK",$J,"POV",PXCENPOV,0,"AFTER")=PXCEPOV_"^"_PXCEPAT_"^"_PXCEVIEN_"^"_PXCENARR_"^^"_PXCEMOD_"^^^^^^"_PXCEPMSC
115 S ^TMP("PXK",$J,"POV",PXCENPOV,800,"BEFORE")=""
116 S ^TMP("PXK",$J,"POV",PXCENPOV,800,"AFTER")=PXCEDXSC
117 S ^TMP("PXK",$J,"POV",PXCENPOV,812,"BEFORE")=""
118 S ^TMP("PXK",$J,"POV",PXCENPOV,812,"AFTER")="^"_PXCEPKG_"^"_PXCESOR
119 Q
120 ;
121 ;
Note: See TracBrowser for help on using the repository browser.