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

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

initial load of WorldVistAEHR

File size: 3.9 KB
Line 
1PXCAPRV ;ISL/dee - Translates data from the PCE Device Interface into PCE's PXK for Providers ;3/14/97
2 ;;1.0;PCE PATIENT CARE ENCOUNTER;**27**;Aug 12, 1996
3 Q
4 ;
5PROVIDER(PXCAENC) ;Provider
6 ; Variables
7 ; PXCAPRV Pointer to the provider (200)
8 ; PXCAPS Primary or Secondary provider for above
9 ; PXCAATND Pointer to the Attending provider (200)
10 ; PXCAFTER Temp used to build ^TMP(PXCAGLB,$J,"PRV",PXCANPRV,0,"AFTER")
11 N PXCAPRV,PXCAPS,PXCAATND,PXCAFTER
12 S PXCAPRV=$P(PXCAENC,"^",4)
13 S PXCAPS=$P(PXCAENC,"^",15)
14 S PXCAATND=$P(PXCAENC,"^",16)
15 I PXCAPRV>0 D
16 . S PXCAFTER=PXCAPRV_"^"
17 . S PXCAFTER=PXCAFTER_PXCAPAT_"^"_PXCAVSIT_"^"
18 . S PXCAFTER=PXCAFTER_PXCAPS_"^"
19 . I PXCAATND>0 D
20 .. I PXCAATND=PXCAPRV S PXCAFTER=PXCAFTER_"A"
21 .. E D ATTEND
22 . S PXCANPRV=PXCANPRV+1
23 . S ^TMP(PXCAGLB,$J,"PRV",PXCANPRV,"IEN")=""
24 . S ^TMP(PXCAGLB,$J,"PRV",PXCANPRV,0,"BEFORE")=""
25 . S ^TMP(PXCAGLB,$J,"PRV",PXCANPRV,0,"AFTER")=PXCAFTER
26 . S ^TMP(PXCAGLB,$J,"PRV",PXCANPRV,812,"BEFORE")=""
27 . S ^TMP(PXCAGLB,$J,"PRV",PXCANPRV,812,"AFTER")="^"_PXCAPKG_"^"_PXCASOR
28 E I PXCAATND>0 D ATTEND
29 Q
30 ;
31ATTEND ;Add the attending provider.
32 S PXCANPRV=PXCANPRV+1
33 S ^TMP(PXCAGLB,$J,"PRV",PXCANPRV,"IEN")=""
34 S ^TMP(PXCAGLB,$J,"PRV",PXCANPRV,0,"BEFORE")=""
35 S ^TMP(PXCAGLB,$J,"PRV",PXCANPRV,0,"AFTER")=PXCAATND_"^"_PXCAPAT_"^"_PXCAVSIT_"^S^A"
36 S ^TMP(PXCAGLB,$J,"PRV",PXCANPRV,812,"BEFORE")=""
37 S ^TMP(PXCAGLB,$J,"PRV",PXCANPRV,812,"AFTER")="^"_PXCAPKG_"^"_PXCASOR
38 Q
39 ;
40ANOTHPRV(PXCAAPRV) ;
41 ;Add the provider to V Provider if they are not there.
42 ;Quit if the provider subscript is zero
43 ; Variables
44 ; PXCAAPRV Pointer to the provider (200)
45 ; PXCAINDX Subscirpt of the provider in the temp array used to
46 ; look to see if the above provider is already know.
47 Q:PXCAAPRV'>0
48 N PXCAINDX
49 S PXCAINDX=0
50 F PXCAINDX=1:1:PXCANPRV I PXCAAPRV=+^TMP(PXCAGLB,$J,"PRV",PXCAINDX,0,"AFTER") S PXCAINDX=0 Q
51 Q:PXCAINDX'>0
52 S PXCANPRV=PXCANPRV+1
53 S ^TMP(PXCAGLB,$J,"PRV",PXCANPRV,"IEN")=""
54 S ^TMP(PXCAGLB,$J,"PRV",PXCANPRV,0,"BEFORE")=""
55 S ^TMP(PXCAGLB,$J,"PRV",PXCANPRV,0,"AFTER")=PXCAAPRV_"^"_PXCAPAT_"^"_PXCAVSIT_"^S"
56 S ^TMP(PXCAGLB,$J,"PRV",PXCANPRV,812,"BEFORE")=""
57 S ^TMP(PXCAGLB,$J,"PRV",PXCANPRV,812,"AFTER")="^"_PXCAPKG_"^"_PXCASOR
58 Q
59 ;
60PRV(PXCAPRV,PXCANPRV,PXCAIEN,PXCAERRS) ;Process the provider nodes
61 N PXCAINDX,PXCANEW
62 S PXCANEW=1
63 F PXCAINDX=1:1:PXCANPRV I PXCAIEN=+^TMP(PXCAGLB,$J,"PRV",PXCAINDX,0,"AFTER") S PXCANEW=0 Q
64 I PXCANEW D
65 . S (PXCANPRV,PXCAINDX)=PXCANPRV+1
66 . S ^TMP(PXCAGLB,$J,"PRV",PXCAINDX,"IEN")=""
67 . S ^TMP(PXCAGLB,$J,"PRV",PXCAINDX,0,"BEFORE")=""
68 . S ^TMP(PXCAGLB,$J,"PRV",PXCAINDX,0,"AFTER")=PXCAIEN_"^"_PXCAPAT_"^"_PXCAVSIT
69 . S ^TMP(PXCAGLB,$J,"PRV",PXCAINDX,812,"BEFORE")=""
70 . S ^TMP(PXCAGLB,$J,"PRV",PXCAINDX,812,"AFTER")="^"_PXCAPKG_"^"_PXCASOR
71 S $P(^TMP(PXCAGLB,$J,"PRV",PXCAINDX,0,"AFTER"),"^",4)=$P(PXCAPRV,"^",1)
72 S:$P(PXCAPRV,"^",2)]"" $P(^TMP(PXCAGLB,$J,"PRV",PXCAINDX,0,"AFTER"),"^",5)=$S($P(PXCAPRV,"^",2)=1:"A",1:"")
73 Q
74 ;
75PROV(PXCA,PXCABULD,PXCAERRS) ;Validate the provider nodes
76 Q:'$D(PXCA("PROVIDER"))
77 N PXCAIEN,PXCAPRV,PXCAITEM
78 S PXCAIEN=""
79 F S PXCAIEN=$O(PXCA("PROVIDER",PXCAIEN)) Q:PXCAIEN']"" D
80 . I '$$ACTIVPRV^PXAPI(PXCAIEN,PXCADT) S PXCA("ERROR","PROVIDER",PXCAIEN,0,0)="Provider is not active or valid^"_PXCAIEN
81 . S PXCAPRV=$G(PXCA("PROVIDER",PXCAIEN))
82 . S PXCAITEM=$P(PXCAPRV,"^",1)
83 . I '(PXCAITEM="P"!(PXCAITEM="S")) S PXCA("ERROR","PROVIDER",PXCAIEN,0,1)="Provider indicator code must be P|S^"_PXCAITEM
84 . E I PXCAITEM="P" D
85 .. I 'PXCAPPRV S PXCAPPRV=PXCAIEN
86 .. E I PXCAPPRV'=PXCAIEN D
87 ... S PXCA("WARNING","PROVIDER",PXCAIEN,0,1)="There is already a Primary Provider this one is changed to Secondary^"_PXCAITEM
88 ... S $P(PXCAPRV,"^",1)="S"
89 . S PXCAITEM=$P(PXCAPRV,"^",2)
90 . I '(PXCAITEM=1!(PXCAITEM=0)!(PXCAITEM="")) S PXCA("ERROR","PROVIDER",PXCAIEN,0,2)="Attending flag bad^"_PXCAITEM
91 . I PXCABULD&'$D(PXCA("ERROR","PROVIDER",PXCAIEN))!PXCAERRS D PRV(PXCAPRV,.PXCANPRV,PXCAIEN,PXCAERRS)
92 Q
93 ;
Note: See TracBrowser for help on using the repository browser.