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

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

initial load of FOIAVistA 6/30/08 version

File size: 3.2 KB
Line 
1PXCAVIMM ;ISL/dee - Validates & Translates data from the PCE Device Interface into PCE's PXK format for Immunizations ;3/14/97
2 ;;1.0;PCE PATIENT CARE ENCOUNTER;**27,124**;Aug 12, 1996
3 Q
4 ; Variables
5 ; PXCAIMM Copy of a IMMUNIZATION node of the PXCA array
6 ; PXCAPRV Pointer to the provider (200)
7 ; PXCANUMB Count of the number if IMMs
8 ; PXCAINDX Count of the number of IMMUNIZATION for one provider
9 ; PXCAFTER Temp used to build ^TMP(PXCAGLB,$J,"IMM",PXCANUMB,0,"AFTER")
10 ; PXCAPNAR Pointer to the provider narrative (9999999.27)
11 ;
12IMM(PXCAIMM,PXCANUMB,PXCAPRV,PXCAERRS) ;
13 N PXCAFTER
14 S PXCAFTER=$P(PXCAIMM,"^",1)_"^"_PXCAPAT_"^"_PXCAVSIT_"^"
15 S PXCAFTER=PXCAFTER_$P(PXCAIMM,"^",2,4)
16 S ^TMP(PXCAGLB,$J,"IMM",PXCANUMB,"IEN")=""
17 S ^TMP(PXCAGLB,$J,"IMM",PXCANUMB,0,"BEFORE")=""
18 ;PX*1*124
19 S ^TMP(PXCAGLB,$J,"IMM",PXCANUMB,0,"AFTER")=PXCAFTER_"^^"_$P(PXCAIMM,"^",8)_"^"_$P(PXCAIMM,"^",9)_"^"_$P(PXCAIMM,"^",10)_"^"_$P(PXCAIMM,"^",11)_"^"_$P(PXCAIMM,"^",12)_"^"_$P(PXCAIMM,"^",13)_"^"_$P(PXCAIMM,"^",14)_"^"_$P(PXCAIMM,"^",15)
20 S ^TMP(PXCAGLB,$J,"IMM",PXCANUMB,12,"BEFORE")=""
21 S ^TMP(PXCAGLB,$J,"IMM",PXCANUMB,12,"AFTER")=$P(PXCAIMM,"^",6)_"^^^"_$S(PXCAPRV>0:PXCAPRV,1:"")
22 S ^TMP(PXCAGLB,$J,"IMM",PXCANUMB,811,"BEFORE")=""
23 S ^TMP(PXCAGLB,$J,"IMM",PXCANUMB,811,"AFTER")=$P(PXCAIMM,"^",7)
24 S ^TMP(PXCAGLB,$J,"IMM",PXCANUMB,812,"BEFORE")=""
25 S ^TMP(PXCAGLB,$J,"IMM",PXCANUMB,812,"AFTER")="^"_PXCAPKG_"^"_PXCASOR
26 Q
27 ;
28IMMUN(PXCA,PXCABULD,PXCAERRS) ;Validation routine for IMM
29 Q:'$D(PXCA("IMMUNIZATION"))
30 N PXCAIMM,PXCAPRV,PXCANUMB,PXCAINDX
31 N PXCAITEM,PXCAITM2
32 S PXCAPRV=""
33 S PXCANUMB=0
34 F S PXCAPRV=$O(PXCA("IMMUNIZATION",PXCAPRV)) Q:PXCAPRV']"" D
35 . I PXCAPRV>0 D
36 .. I '$$ACTIVPRV^PXAPI(PXCAPRV,PXCADT) S PXCA("ERROR","IMMUNIZATION",PXCAPRV,0,0)="Provider is not active or valid^"_PXCAPRV
37 .. E I PXCABULD!PXCAERRS D ANOTHPRV^PXCAPRV(PXCAPRV)
38 . S PXCAINDX=0
39 . F S PXCAINDX=$O(PXCA("IMMUNIZATION",PXCAPRV,PXCAINDX)) Q:PXCAINDX']"" D
40 .. S PXCAIMM=$G(PXCA("IMMUNIZATION",PXCAPRV,PXCAINDX))
41 .. S PXCANUMB=PXCANUMB+1
42 .. I PXCAIMM="" S PXCA("ERROR","IMMUNIZATION",PXCAPRV,PXCAINDX,0)="IMMUNIZATION data missing" Q
43 .. S PXCAITEM=+$P(PXCAIMM,U,1)
44 .. I $G(^AUTTIMM(PXCAITEM,0))="" S PXCA("ERROR","IMMUNIZATION",PXCAPRV,PXCAINDX,1)="IMMUNIZATION type not in file 9999999.14^"_PXCAITEM
45 .. S PXCAITEM=$P(PXCAIMM,U,2)
46 .. I '(PXCAITEM=""!(PXCAITEM="P")!(PXCAITEM="C")!(PXCAITEM="B")!((PXCAITEM=(PXCAITEM\1))&(PXCAITEM>0)&(PXCAITEM<9))) S PXCA("ERROR","IMMUNIZATION",PXCAPRV,PXCAINDX,2)="IMMUNIZATION series must be P|C|B|1|2|3|4|5|6|7|8^"_PXCAITEM
47 .. S PXCAITEM=$P(PXCAIMM,U,4)
48 .. I '((PXCAITEM=(PXCAITEM\1)&(PXCAITEM>0)&(PXCAITEM<12))!(PXCAITEM="")) S PXCA("ERROR","IMMUNIZATION",PXCAPRV,PXCAINDX,4)="IMMUNIZATION reaction must be an integer form 1 to 11^"_PXCAITEM
49 .. S PXCAITEM=$P(PXCAIMM,U,5)
50 .. I '(PXCAITEM=1!(PXCAITEM=0)!(PXCAITEM="")) S PXCA("ERROR","IMMUNIZATION",PXCAPRV,PXCAINDX,5)="IMMUNIZATION contraindicated flag bad^"_PXCAITEM
51 .. S PXCAITEM=$P(PXCAIMM,U,6)
52 .. S PXCAITEM=$P(PXCAIMM,U,7)
53 .. I $L(PXCAITEM)>80 S PXCA("ERROR","IMMUNIZATION",PXCAPRV,PXCAINDX,6)="IMMUNIZATION remarks must be 1-80 Characters^"_PXCAITEM
54 .. I PXCABULD&'$D(PXCA("ERROR","IMMUNIZATION",PXCAPRV,PXCAINDX))!PXCAERRS D IMM(PXCAIMM,.PXCANUMB,PXCAPRV,PXCAERRS)
55 Q
56 ;
Note: See TracBrowser for help on using the repository browser.