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

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

initial load of WorldVistAEHR

File size: 4.2 KB
Line 
1PXAIPRV ;ISL/JVS,ESW - SET THE PROVIDER NODES ;6/3/05 12:29pm
2 ;;1.0;PCE PATIENT CARE ENCOUNTER;**5,108,124**;Aug 12, 1996
3 ;
4 Q
5PRV ;--CREAT PROVIDERS
6 ;
7SET ;--SET AND NEW VARIABLES
8 N AFTER0,AFTER12,AFTER801,AFTER811,AFTER812
9 N BEFOR0,BEFOR12,BEFOR801,BEFOR811,BEFOR812
10 N PXAA,PXAB,SUB,PIECE,PXAAX,IENB,STOP
11 ;
12 K PXAERR
13 S PXAERR(8)=PXAK
14 S PXAERR(7)="PROVIDER"
15 ;
16 S SUB="" F S SUB=$O(@PXADATA@("PROVIDER",PXAK,SUB)) Q:SUB="" D
17 .S PXAA(SUB)=@PXADATA@("PROVIDER",PXAK,SUB)
18 ;
19 ;--VALIDATE ENOUGH DATA
20 D VAL^PXAIPRVV Q:$G(STOP)
21 ;
22SETVARA ;--SET VISIT VARIABLES
23 S $P(AFTER0,"^",1)=$G(PXAA("NAME"))
24 I $G(PXAA("DELETE")) S $P(AFTER0,"^",1)="@"
25 S $P(AFTER0,"^",2)=$G(PATIENT)
26 S $P(AFTER0,"^",3)=$G(PXAVISIT)
27 S $P(AFTER0,"^",4)=$S($G(PXAA("PRIMARY"))=1:"P",1:"S")
28 S $P(AFTER0,"^",5)=$S($G(PXAA("ATTENDING"))=1:"A",$G(PXAA("ATTENDING"))=0:"@",1:"")
29 S $P(AFTER811,"^",1)=$G(PXAA("COMMENT"))
30 ;
31 ;
32 S $P(AFTER812,"^",2)=$G(PXAPKG)
33 S $P(AFTER812,"^",3)=$G(PXASOURC)
34 ;
35SETPXKA ;--SET PXK ARRAY AFTER
36 S ^TMP("PXK",$J,"PRV",PXAK,0,"AFTER")=AFTER0
37 S ^TMP("PXK",$J,"PRV",PXAK,811,"AFTER")=AFTER811
38 S ^TMP("PXK",$J,"PRV",PXAK,812,"AFTER")=AFTER812
39 ;
40SETVARB ;--SET VARIABLES BEFORE
41 ;
42 ;--CHECK FOR PRIMARY DESIGNATION
43 N ITEM,PXBSKY,PXBKY,PXBSAM,PXBCNT,PRVDR,FPRI
44 D PRV^PXBGPRV(PXAVISIT,.PXBSKY,.PXBKY,.PXBSAM,.PXBCNT,.PRVDR,.FPRI)
45 ;CHECK NAME
46 S PXAAX("NAME")=$P($G(^VA(200,$G(PXAA("NAME")),0)),"^",1)
47 I '$G(PXAPREDT) D
481 .I $D(PRVDR),$P($G(PRVDR("PRIMARY")),U)'=PXAAX("NAME") S PRI=1
492 .I $G(PRI),$P(AFTER0,"^",4)="P",$P(AFTER0,"^",1)'="@" D VAL04^PXAIPRVV,ERR^PXAI
503 .I $G(PRI) S $P(^TMP("PXK",$J,"PRV",PXAK,0,"AFTER"),"^",4)="S"
514 .I $P(AFTER0,"^",4)="P" S PRI=1
52 ;
53 ;--GET IEN FOR 'PXK NODE'
54 I $G(PXAA("DELETE"))=1 S PXAAX("NAME")=$P($G(^VA(200,PXAA("NAME"),0)),"^",1)
55 S ITEM="" I PXBCNT>0,$G(PXAAX("NAME"))]"" S ITEM=$O(PXBKY(PXAAX("NAME"),0))
56 I ITEM]"" S (^TMP("PXK",$J,"PRV",PXAK,"IEN"),IENB)=$O(PXBSKY(ITEM,0))
57 ;
58 I $G(IENB) D
59 .F PIECE=0,811,812 S ^TMP("PXK",$J,"PRV",PXAK,PIECE,"BEFORE")=$G(^AUPNVPRV(IENB,PIECE))
60 E D
61 .S (BEFOR0,BEFOR811,BEFOR812)=""
62 .;
63SETPXKB .;--SET PXK ARRAY BEFORE
64 .S ^TMP("PXK",$J,"PRV",PXAK,0,"BEFORE")=BEFOR0
65 .S ^TMP("PXK",$J,"PRV",PXAK,811,"BEFORE")=BEFOR811
66 .S ^TMP("PXK",$J,"PRV",PXAK,812,"BEFORE")=BEFOR812
67 .S ^TMP("PXK",$J,"PRV",PXAK,"IEN")=""
68 ;
69MISC ;--MISCELLANEOUS NODE
70 ;
71 Q
72OTHER ;---ADD OTHER PROVIDERS TO V PROVIDER FOR OTHER ENTRIES
73 ;
74 ; generate data, PXBSKY(), about currently filed providers
75 ;
76 N PXBSKY
77 I $G(PXAVISIT) D PRV^PXBGPRV(PXAVISIT,.PXBSKY)
78 ;
79 N IEN,AFTER0,CNT,PXAK,STOP,FF
80 S IEN="",CNT=1000
81 ;
82 ;---^TMP("PXAIADDPRV",$J,'IEN')=""
83 ;
84 F S IEN=$O(^TMP("PXAIADDPRV",$J,IEN)),CNT=CNT+1 Q:IEN="" D
85 .;
86 .;verify if an entry for a provider already exists
87 .;
88 .S STOP=0
89 .I $D(^TMP("PXK",$J,"PRV")) S PXAK="" D Q:STOP
90 ..F S PXAK=$O(^TMP("PXK",$J,"PRV",PXAK)) Q:PXAK="" D Q:STOP
91 ...I +$G(^TMP("PXK",$J,"PRV",PXAK,0,"AFTER"))=IEN S STOP=1
92 .S FF="PXBSKY" F S FF=$Q(@FF) Q:FF="" I @FF=IEN S STOP=1 Q
93 .Q:STOP
94 .;
95 .S $P(AFTER0,"^",1)=IEN
96 .S $P(AFTER0,"^",2)=$P(^AUPNVSIT(PXAVISIT,0),"^",5)
97 .S $P(AFTER0,"^",3)=PXAVISIT
98 .S $P(AFTER0,"^",4)="S"
99 .S $P(AFTER812,"^",2)=$G(PXAPKG)
100 .S $P(AFTER812,"^",3)=$G(PXASOURC)
101 .S ^TMP("PXK",$J,"PRV",CNT,0,"AFTER")=$G(AFTER0)
102 .S ^TMP("PXK",$J,"PRV",CNT,811,"AFTER")=""
103 .S ^TMP("PXK",$J,"PRV",CNT,812,"AFTER")=$G(AFTER812)
104 .S ^TMP("PXK",$J,"PRV",CNT,0,"BEFORE")=""
105 .S ^TMP("PXK",$J,"PRV",CNT,811,"BEFORE")=""
106 .S ^TMP("PXK",$J,"PRV",CNT,812,"BEFORE")=""
107 .S ^TMP("PXK",$J,"PRV",CNT,"IEN")=""
108 K ^TMP("PXAIADDPRV",$J)
109 Q
110PRIM ;--SET A PROVIDER AS PRIMARY
111 N PXBCNT,PXBKY,PXBSAM,PXBSKY,AFTER0,FPRI,PRVDR,PXASOR
112 D PRV^PXBGPRV(PXAVISIT,.PXBSKY,.PXBKY,.PXBSAM,.PXBCNT,.PRVDR,.FPRI)
113 I $D(PRVDR) Q
114 I '$D(PXBSKY) Q
115 ;----ADDED
116 S PXASOR=$G(^TMP("PXK",$J,"SOR"))
117 K ^TMP("PXK",$J)
118 S ^TMP("PXK",$J,"SOR")=$G(PXASOR)
119 S ^TMP("PXK",$J,"VST",1,"IEN")=PXAVISIT
120 ;-------
121 ;
122 S $P(AFTER0,"^",1)=$P(^AUPNVPRV($O(PXBSKY(1,0)),0),"^",1)
123 S $P(AFTER0,"^",2)=$P(^AUPNVSIT(PXAVISIT,0),"^",5)
124 S $P(AFTER0,"^",3)=PXAVISIT
125 S $P(AFTER0,"^",4)="P"
126 S ^TMP("PXK",$J,"PRV",22222,0,"AFTER")=AFTER0
127 S ^TMP("PXK",$J,"PRV",22222,0,"BEFORE")=$G(^AUPNVPRV($O(PXBSKY(1,0)),0))
128 S ^TMP("PXK",$J,"PRV",22222,"IEN")=$O(PXBSKY(1,0))
129 D EN1^PXKMAIN
130 K PXRDR
131 Q
Note: See TracBrowser for help on using the repository browser.