source: FOIAVistA/trunk/r/PCE_PATIENT_CARE_ENCOUNTER-AUTN-EFDP-PX-VSIT--PXRM/PXCADX.m@ 847

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

initial load of FOIAVistA 6/30/08 version

File size: 2.8 KB
Line 
1PXCADX ;ISL/dee & LEA/Chylton - Translates data from the PCE Device Interface into PCE's PXK format for POV ;8/1/96
2 ;;1.0;PCE PATIENT CARE ENCOUNTER;;Aug 12, 1996
3 Q
4 ;
5POV(PXCADIAG,PXCANUMB,PXCAPRV,PXCAERRS) ;DIAGNOSIS node
6 ; Variables
7 ; PXCADIAG Copy of a Diagnosis node of the PXCA array
8 ; PXCAPRV Pointer to the provider (200)
9 ; PXCANUMB Count of the number if POVs
10 ; PXCAFTER Temp used to build ^TMP(PXCAGLB,$J,"POV",PXCANUMB,0,"AFTER")
11 ;
12 N PXCAFTER,PXCAITEM
13 S PXCAFTER=$P(PXCADIAG,"^",1)_"^"
14 S PXCAFTER=PXCAFTER_PXCAPAT_"^"_PXCAVSIT_"^"
15 S PXCAFTER=PXCAFTER_$P(PXCADIAG,"^",8)_"^^^^^^^^"
16 S PXCAITEM=$P(PXCADIAG,"^",2)
17 S PXCAITEM=$S(PXCAITEM["P":"P",PXCAITEM["S":"S",1:"")
18 S PXCAFTER=PXCAFTER_PXCAITEM_"^^^"
19 S PXCAFTER=PXCAFTER_$P(PXCADIAG,"^",10)_"^"
20 S PXCAFTER=PXCAFTER_$P(PXCADIAG,"^",7)
21 S ^TMP(PXCAGLB,$J,"POV",PXCANUMB,"IEN")=""
22 S ^TMP(PXCAGLB,$J,"POV",PXCANUMB,0,"BEFORE")=""
23 S ^TMP(PXCAGLB,$J,"POV",PXCANUMB,0,"AFTER")=PXCAFTER
24 S ^TMP(PXCAGLB,$J,"POV",PXCANUMB,12,"BEFORE")=""
25 S ^TMP(PXCAGLB,$J,"POV",PXCANUMB,12,"AFTER")="^^^"_$S(PXCAPRV>0:PXCAPRV,1:"")
26 S ^TMP(PXCAGLB,$J,"POV",PXCANUMB,800,"BEFORE")=""
27 S ^TMP(PXCAGLB,$J,"POV",PXCANUMB,800,"AFTER")=$P(PXCADIAG,"^",3,6)
28 S ^TMP(PXCAGLB,$J,"POV",PXCANUMB,802,"BEFORE")=""
29 S ^TMP(PXCAGLB,$J,"POV",PXCANUMB,802,"AFTER")=$P(PXCADIAG,"^",9)
30 S ^TMP(PXCAGLB,$J,"POV",PXCANUMB,812,"BEFORE")=""
31 S ^TMP(PXCAGLB,$J,"POV",PXCANUMB,812,"AFTER")="^"_PXCAPKG_"^"_PXCASOR
32 Q
33 ;
34 ;
35DX(PXCADXPL,PXCANUMB,PXCAPRV,PXCAERRS) ;DIAGNOSIS/PROBLEM node
36 ; Variables
37 ; PXCADXPL Copy of a DIAGNOSIS/PROBLEM node of the PXCA array
38 ; PXCANUMB Count of the number if POVs
39 ; PXCAPRV Pointer to the provider
40 ; PXCAFTER Temp used to build ^TMP(PXCAGLB,$J,"POV",PXCANUMB,0,"AFTER")
41 ; PXCAITEM Temp used to hold an item while processing it
42 ;
43 N PXCAFTER,PXCAITEM
44 S PXCAFTER=$P(PXCADXPL,"^",1)_"^"
45 S PXCAFTER=PXCAFTER_PXCAPAT_"^"_PXCAVSIT_"^"
46 S PXCAFTER=PXCAFTER_$P(PXCADXPL,"^",13)_"^^^^^^^^"
47 S PXCAITEM=$P(PXCADXPL,"^",2)
48 S PXCAITEM=$S(PXCAITEM["P":"P",PXCAITEM["S":"S",1:"")
49 S PXCAFTER=PXCAFTER_PXCAITEM_"^^^"
50 S PXCAFTER=PXCAFTER_$P(PXCADXPL,"^",3)_"^"
51 S PXCAFTER=PXCAFTER_$P(PXCADXPL,"^",4)
52 S ^TMP(PXCAGLB,$J,"POV",PXCANUMB,"IEN")=""
53 S ^TMP(PXCAGLB,$J,"POV",PXCANUMB,0,"BEFORE")=""
54 S ^TMP(PXCAGLB,$J,"POV",PXCANUMB,0,"AFTER")=PXCAFTER
55 S ^TMP(PXCAGLB,$J,"POV",PXCANUMB,12,"BEFORE")=""
56 S ^TMP(PXCAGLB,$J,"POV",PXCANUMB,12,"AFTER")="^^^"_$S(PXCAPRV>0:PXCAPRV,1:"")
57 S ^TMP(PXCAGLB,$J,"POV",PXCANUMB,800,"BEFORE")=""
58 S ^TMP(PXCAGLB,$J,"POV",PXCANUMB,800,"AFTER")=$P(PXCADXPL,"^",9,12)
59 S ^TMP(PXCAGLB,$J,"POV",PXCANUMB,802,"BEFORE")=""
60 S ^TMP(PXCAGLB,$J,"POV",PXCANUMB,802,"AFTER")=$P(PXCADXPL,"^",14)
61 S ^TMP(PXCAGLB,$J,"POV",PXCANUMB,812,"BEFORE")=""
62 S ^TMP(PXCAGLB,$J,"POV",PXCANUMB,812,"AFTER")="^"_PXCAPKG_"^"_PXCASOR
63 Q
64 ;
Note: See TracBrowser for help on using the repository browser.