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

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

initial load of WorldVistAEHR

File size: 4.4 KB
Line 
1PXAIPOV ;ISL/JVS,ESW - SET THE DIAGNOSIS/PROBLEM LIST NODES ;6/25/03 2:05pm
2 ;;1.0;PCE PATIENT CARE ENCOUNTER;**28,73,69,108,112,130,124,174**;Aug 12, 1996
3 ;
4 Q
5POV ;--CREATE DIAGNOSIS
6 ;
7SET ;--SET AND NEW VARIABLES
8 N AFTER0,AFTER12,AFTER800,AFTER801,AFTER811,AFTER802,AFTER812
9 N BEFOR0,BEFOR12,BEFOR800,BEFOR801,BEFOR811,BEFOR802,BEFOR812
10 N PXAA,PXAB,SUB,PIECE,PXAAX,IENB,STOP,VAR,AFTER8A
11 N FPRI,J,LNARR,GMPSAVED,NOPLLIST,PXDIGNS,VAR,PRI
12 N POVI,PRVDR,PXBCNT,PXBCNTPL,PXBKY,PXBPMT,PXBSAM,PXBSKY,PXKDONE
13 ;
14 K PXAERR
15 S PXAERR(8)=PXAK
16 S PXAERR(7)="DX/PL"
17 ;
18 S SUB="" F S SUB=$O(@PXADATA@("DX/PL",PXAK,SUB)) Q:SUB="" D
19 .S PXAA(SUB)=@PXADATA@("DX/PL",PXAK,SUB)
20 ;
21 ;--VALIDATE ENOUGH DATA
22 D VAL^PXAIPOVV Q:$G(STOP)
23 ;
24SETVARA ;--SET VISIT VARIABLES
25 S $P(AFTER0,"^",1)=$G(PXAA("DIAGNOSIS"))
26 I $G(PXAA("DELETE")) S $P(AFTER0,"^",1)="@"
27 S $P(AFTER0,"^",2)=$G(PATIENT),PXAA("PATIENT")=$G(PATIENT)
28 S $P(AFTER0,"^",3)=$G(PXAVISIT)
29 S $P(AFTER0,"^",4)=$G(PXAA("NARRATIVE")) D
30 .I $G(PXAA("NARRATIVE"))']""!($L($G(PXAA("NARRATIVE")))>245) D
31 ..S PXAA("NARRATIVE")=$$EXTTEXT^PXUTL1($G(PXAA("DIAGNOSIS")),1,80,10,3) ;--TEXT OF NARRATIVE
32 .S $P(AFTER0,"^",4)=+$$PROVNARR^PXAPI($G(PXAA("NARRATIVE")),9000010.07)
33 ;PX*1*124
34 S $P(AFTER0,"^",12)=$S($G(PXAA("PRIMARY"))=1:"P",$G(PXAA("PRIMARY"))="P":"P",1:"S")
35 ;--ADDED FOR PATCH 28
36 S $P(AFTER0,"^",15)=$G(PXAA("LEXICON TERM"))
37 S $P(AFTER0,"^",16)=$G(PXAA("PL IEN"))
38 S $P(AFTER0,"^",17)=$G(PXAA("ORD/RES"))
39 ;--END OF NEW PATCH 28
40 S $P(AFTER12,"^",1)=$G(PXAA("EVENT D/T"))
41 S $P(AFTER12,"^",4)=$G(PXAA("ENC PROVIDER"))
42 ;PX*1*108
43 I $G(PXAA("ENC PROVIDER"))]"",'$G(PXAA("DELETE")) D
44 .S ^TMP("PXAIADDPRV",$J,$G(PXAA("ENC PROVIDER")))=""
45 ;
46 I $G(PXAA("CATEGORY"))]"" S $P(AFTER802,"^",1)=+$$PROVNARR^PXAPI($G(PXAA("CATEGORY")),9000010.07)
47 S $P(AFTER811,"^",1)=$G(PXAA("COMMENT"))
48 ;
49 S $P(AFTER800,"^",1)=$G(PXAA("PL SC"))
50 S $P(AFTER800,"^",2)=$G(PXAA("PL AO"))
51 S $P(AFTER800,"^",3)=$G(PXAA("PL IR"))
52 S $P(AFTER800,"^",4)=$G(PXAA("PL EC"))
53 S $P(AFTER800,"^",5)=$G(PXAA("PL MST"))
54 S $P(AFTER800,"^",6)=$G(PXAA("PL HNC"))
55 S $P(AFTER800,"^",7)=$G(PXAA("PL CV"))
56 ;
57 D SCC^PXUTLSCC(PATIENT,$P($G(^AUPNVSIT(PXAVISIT,0)),"^",1),$P($G(^AUPNVSIT(PXAVISIT,0)),"^",22),$G(PXAVISIT),AFTER800,.AFTER800)
58 ;
59 I $G(PXAA("PL SC"))="" S $P(AFTER800,"^",1)=""
60 I $G(PXAA("PL AO"))="" S $P(AFTER800,"^",2)=""
61 I $G(PXAA("PL IR"))="" S $P(AFTER800,"^",3)=""
62 I $G(PXAA("PL EC"))="" S $P(AFTER800,"^",4)=""
63 I $G(PXAA("PL MST"))="" S $P(AFTER800,"^",5)=""
64 I $G(PXAA("PL HNC"))="" S $P(AFTER800,"^",6)=""
65 I $G(PXAA("PL CV"))="" S $P(AFTER800,"^",7)=""
66 ;
67 S $P(AFTER812,"^",3)=$G(PXASOURC)
68 S $P(AFTER812,"^",2)=$G(PXAPKG)
69 ;
70 D PL^PXAIPL
71 ;
72 ;
73SETPXKA ;--SET PXK ARRAY AFTER
74 S ^TMP("PXK",$J,"POV",PXAK,0,"AFTER")=$G(AFTER0)
75 S ^TMP("PXK",$J,"POV",PXAK,12,"AFTER")=$G(AFTER12)
76 S ^TMP("PXK",$J,"POV",PXAK,800,"AFTER")=$G(AFTER800)
77 S ^TMP("PXK",$J,"POV",PXAK,802,"AFTER")=$G(AFTER802)
78 S ^TMP("PXK",$J,"POV",PXAK,811,"AFTER")=$G(AFTER811)
79 S ^TMP("PXK",$J,"POV",PXAK,812,"AFTER")=$G(AFTER812)
80 ;
81SETVARB ;--SET VARIABLES BEFORE
82 ;
83 ;--GET IEN FOR 'PXK NODE'
84 D POV^PXBGPOV(PXAVISIT)
85 I $D(^TMP("PXBGPOVMATCH",$J,$G(PXAA("DIAGNOSIS")))) D
86 .S (^TMP("PXK",$J,"POV",PXAK,"IEN"),IENB)=$O(^TMP("PXBGPOVMATCH",$J,$G(PXAA("DIAGNOSIS")),0))
87 K ^TMP("PXBGPOVMATCH",$J)
88 ;
89BEFOR ;
90 I $G(IENB) D
91 .F PIECE=0,12,800,802,811 S ^TMP("PXK",$J,"POV",PXAK,PIECE,"BEFORE")=$G(^AUPNVPOV(IENB,PIECE))
92 .K ^TMP("PXK",$J,"POV",PXAK,812)
93 E D
94 .S (BEFOR0,BEFOR12,BEFOR800,BEFOR802,BEFOR811,BEFOR812)=""
95 .;
96SETPXKB .;--SET PXK ARRAY BEFORE
97 .S ^TMP("PXK",$J,"POV",PXAK,0,"BEFORE")=$G(BEFOR0)
98 .S ^TMP("PXK",$J,"POV",PXAK,12,"BEFORE")=$G(BEFOR12)
99 .S ^TMP("PXK",$J,"POV",PXAK,800,"BEFORE")=$G(BEFOR800)
100 .S ^TMP("PXK",$J,"POV",PXAK,802,"BEFORE")=$G(BEFOR802)
101 .S ^TMP("PXK",$J,"POV",PXAK,811,"BEFORE")=$G(BEFOR811)
102 .S ^TMP("PXK",$J,"POV",PXAK,812,"BEFORE")=$G(BEFOR812)
103 .S ^TMP("PXK",$J,"POV",PXAK,"IEN")=""
104 ;
105MISC ;--MISCELLANEOUS NODE
106 ;
107 Q
108PRIM ;--SET A PROVIDER AS PRIMARY
109 N PXBCNT,PXBKY,PXBSAM,PXBSKY,PRVDR,FPRI ;108
110 D PRV^PXBGPRV(PXAVISIT,.PXBSKY,.PXBKY,.PXBSAM,.PXBCNT,.PRVDR,.FPRI) ;108
111 I $D(PRVDR) Q
112 I '$D(PXBSKY) Q
113 ;
114 S $P(AFTER0,"^",1)=$P(^AUPNVPRV($O(PXBSKY(1,0)),0),"^",1)
115 S $P(AFTER0,"^",2)=$P(^AUPNVSIT(PXAVISIT,0),"^",5)
116 S $P(AFTER0,"^",3)=PXAVISIT
117 S $P(AFTER0,"^",4)="P"
118 S ^TMP("PXK",$J,"PRV",22222,0,"AFTER")=AFTER0
119 S ^TMP("PXK",$J,"PRV",22222,0,"BEFORE")=$G(^AUPNVPRV($O(PXBSKY(1,0)),0))
120 S ^TMP("PXK",$J,"PRV",22222,"IEN")=$O(PXBSKY(1,0))
121 D EN1^PXKMAIN
122 K PXRDR
123 K ^TMP("PXBGPOVMATCH",$J)
124 Q
Note: See TracBrowser for help on using the repository browser.