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

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

initial load of WorldVistAEHR

File size: 3.2 KB
RevLine 
[613]1PXCACPT1 ;ISL/dee & LEA/Chylton - Validates & Translates data from the PCE Device Interface into PCE's PXK format for CPTs ;8/1/96
2 ;;1.0;PCE PATIENT CARE ENCOUNTER;**73,121,124**;Aug 12, 1996
3 Q
4 ; Variables
5 ; PXCA Copy of PXCA array
6 ; PXCAPROC Copy of a Procedure node of the PXCA array
7 ; PXCAPRV Pointer to the provider (200)
8 ; PXCANUMB Count of the number if CPTs and treatments
9 ; PXCAINDX Count of the number of procedures for one provider
10 ; PXCAFTER Temp used to build ^TMP(PXCAGLB,$J,"CPT",PXCANPRV,0,"AFTER")
11 ; or to build ^TMP(PXCAGLB,$J,"TRT",PXCANPRV,0,"AFTER")
12 ;
13CPT(PXCA,PXCAPROC,PXCANUMB,PXCAPRV,PXCAINDX,PXCAERRS) ;CPT
14 N PXCAFTER,PXCACNT,PXCASTR,PXCAWARN,PXMDIEN
15 S PXCAFTER=$P(PXCAPROC,"^",1)_"^"
16 S PXCAFTER=PXCAFTER_PXCAPAT_"^"_PXCAVSIT_"^"
17 S PXCAFTER=PXCAFTER_$P(PXCAPROC,"^",6)_"^"
18 S PXCAFTER=PXCAFTER_$P(PXCAPROC,"^",5)_"^^" ;1ST Dx
19 S PXCAFTER=PXCAFTER_$S($P(PXCAPROC,"^",3)="P":"Y",$P(PXCAPROC,"^",3)="S":"N",1:"")_"^^"
20 S PXCAFTER=PXCAFTER_$P(PXCAPROC,"^",8)_"^" ;2nd Dx
21 S PXCAFTER=PXCAFTER_$P(PXCAPROC,"^",9)_"^" ;3rd Dx
22 S PXCAFTER=PXCAFTER_$P(PXCAPROC,"^",10)_"^" ;4th Dx
23 S PXCAFTER=PXCAFTER_$P(PXCAPROC,"^",11)_"^" ;5th Dx
24 S PXCAFTER=PXCAFTER_$P(PXCAPROC,"^",12)_"^" ;6th Dx
25 S PXCAFTER=PXCAFTER_$P(PXCAPROC,"^",13)_"^" ;7th Dx
26 S PXCAFTER=PXCAFTER_$P(PXCAPROC,"^",14)_"^" ;8th Dx
27 S PXCAFTER=PXCAFTER_$P(PXCAPROC,"^",2)
28 S ^TMP(PXCAGLB,$J,"CPT",PXCANUMB,"IEN")=""
29 S ^TMP(PXCAGLB,$J,"CPT",PXCANUMB,0,"BEFORE")=""
30 S ^TMP(PXCAGLB,$J,"CPT",PXCANUMB,0,"AFTER")=PXCAFTER
31 IF $P(PXCAFTER,"^",5)]"" D ANOTHPOV^PXCAPOV($P(PXCAFTER,"^",5))
32 IF $P(PXCAFTER,"^",9)]"" D ANOTHPOV^PXCAPOV($P(PXCAFTER,"^",9))
33 IF $P(PXCAFTER,"^",10)]"" D ANOTHPOV^PXCAPOV($P(PXCAFTER,"^",10))
34 IF $P(PXCAFTER,"^",11)]"" D ANOTHPOV^PXCAPOV($P(PXCAFTER,"^",11))
35 IF $P(PXCAFTER,"^",12)]"" D ANOTHPOV^PXCAPOV($P(PXCAFTER,"^",12))
36 IF $P(PXCAFTER,"^",13)]"" D ANOTHPOV^PXCAPOV($P(PXCAFTER,"^",13))
37 IF $P(PXCAFTER,"^",14)]"" D ANOTHPOV^PXCAPOV($P(PXCAFTER,"^",14))
38 IF $P(PXCAFTER,"^",15)]"" D ANOTHPOV^PXCAPOV($P(PXCAFTER,"^",15))
39 ;Set modifier nodes
40 S (PXCAMOD,PXCAWARN)=""
41 F PXCACNT=1:1 S PXCAMOD=$O(PXCA("PROCEDURE",PXCAPRV,PXCAINDX,PXCAMOD)) Q:PXCAMOD="" D
42 . S PXMDIEN=$$MODP^ICPTMOD(+PXCAFTER,PXCAMOD,"E",PXCADT)
43 . I +PXMDIEN<1 D Q
44 .. S PXCAWARN=$S(PXCAWARN="":"",1:PXCAWARN_",")_PXCAMOD
45 .. S PXCA("PROCEDURE",PXCAPRV,PXCAINDX,PXCAMOD)="Invalid Modifier"
46 . S PXCASTR=$$MOD^ICPTMOD(PXMDIEN,"I",PXCADT)
47 . S ^TMP(PXCAGLB,$J,"CPT",PXCANUMB,1,PXCACNT,"BEFORE")=""
48 . S ^TMP(PXCAGLB,$J,"CPT",PXCANUMB,1,PXCACNT,"AFTER")=+PXCASTR
49 . I PXCA("PROCEDURE",PXCAPRV,PXCAINDX,PXCAMOD)="" D
50 .. S PXCA("PROCEDURE",PXCAPRV,PXCAINDX,PXCAMOD)=$P(PXCASTR,"^",1,3)
51 I PXCAWARN]"" D
52 . S PXCA("WARNING","PROCEDURE",PXCAPRV,PXCAINDX,0)="CPT Modifier(s) "_PXCAWARN_" invalid. Code(s) not stored."
53 S ^TMP(PXCAGLB,$J,"CPT",PXCANUMB,12,"BEFORE")=""
54 S ^TMP(PXCAGLB,$J,"CPT",PXCANUMB,12,"AFTER")=$P(PXCAPROC,"^",4)_"^^^"_$S(PXCAPRV>0:PXCAPRV,1:"")
55 S ^TMP(PXCAGLB,$J,"CPT",PXCANUMB,802,"BEFORE")=""
56 S ^TMP(PXCAGLB,$J,"CPT",PXCANUMB,802,"AFTER")=$P(PXCAPROC,"^",7)
57 S ^TMP(PXCAGLB,$J,"CPT",PXCANUMB,812,"BEFORE")=""
58 S ^TMP(PXCAGLB,$J,"CPT",PXCANUMB,812,"AFTER")="^"_PXCAPKG_"^"_PXCASOR
59 Q
60 ;
Note: See TracBrowser for help on using the repository browser.