1 | PXCASK ;ISL/dee - Validates & Translates data from the PCE Device Interface into PCE's PXK format for Skin Test ;3/14/97
|
---|
2 | ;;1.0;PCE PATIENT CARE ENCOUNTER;**27,124**;Aug 12, 1996
|
---|
3 | Q
|
---|
4 | ; Variables
|
---|
5 | ; PXCASK Copy of a SKIN TEST node of the PXCA array
|
---|
6 | ; PXCAPRV Pointer to the provider (200)
|
---|
7 | ; PXCANUMB Count of the number if SKs
|
---|
8 | ; PXCAINDX Count of the number of SKIN TEST for one provider
|
---|
9 | ; PXCAFTER Temp used to build ^TMP(PXCAGLB,$J,"SK",PXCANUMB,0,"AFTER")
|
---|
10 | ; PXCAPNAR Pointer to the provider narrative (9999999.27)
|
---|
11 | ;
|
---|
12 | SK(PXCASK,PXCANUMB,PXCAPRV,PXCAERRS) ;
|
---|
13 | N PXCAFTER
|
---|
14 | S PXCAFTER=$P(PXCASK,"^",1)_"^"_PXCAPAT_"^"_PXCAVSIT_"^"
|
---|
15 | S PXCAFTER=PXCAFTER_$P(PXCASK,"^",3)_"^"
|
---|
16 | S PXCAFTER=PXCAFTER_$P(PXCASK,"^",2)_"^"
|
---|
17 | ;PX*1*124
|
---|
18 | S PXCAFTER=PXCAFTER_$P(PXCASK,"^",4)_"^^"_$P(PXCASK,"^",6)_"^"_$P(PXCASK,"^",7)_"^"_$P(PXCASK,"^",8)_"^"_$P(PXCASK,"^",9)_"^"_$P(PXCASK,"^",10)_"^"_$P(PXCASK,"^",11)_"^"_$P(PXCASK,"^",12)_"^"_$P(PXCASK,"^",13)
|
---|
19 | S ^TMP(PXCAGLB,$J,"SK",PXCANUMB,"IEN")=""
|
---|
20 | S ^TMP(PXCAGLB,$J,"SK",PXCANUMB,0,"BEFORE")=""
|
---|
21 | S ^TMP(PXCAGLB,$J,"SK",PXCANUMB,0,"AFTER")=PXCAFTER
|
---|
22 | S ^TMP(PXCAGLB,$J,"SK",PXCANUMB,12,"BEFORE")=""
|
---|
23 | S ^TMP(PXCAGLB,$J,"SK",PXCANUMB,12,"AFTER")=$P(PXCASK,"^",5)_"^^^"_$S(PXCAPRV>0:PXCAPRV,1:"")
|
---|
24 | S ^TMP(PXCAGLB,$J,"SK",PXCANUMB,812,"BEFORE")=""
|
---|
25 | S ^TMP(PXCAGLB,$J,"SK",PXCANUMB,812,"AFTER")="^"_PXCAPKG_"^"_PXCASOR
|
---|
26 | Q
|
---|
27 | ;
|
---|
28 | SKINTEST(PXCA,PXCABULD,PXCAERRS) ;Validation routine for SK
|
---|
29 | Q:'$D(PXCA("SKIN TEST"))
|
---|
30 | N PXCASK,PXCAPRV,PXCANUMB,PXCAINDX,PXCAITEM
|
---|
31 | S PXCAPRV=""
|
---|
32 | S PXCANUMB=0
|
---|
33 | F S PXCAPRV=$O(PXCA("SKIN TEST",PXCAPRV)) Q:PXCAPRV']"" D
|
---|
34 | . I PXCAPRV>0 D
|
---|
35 | .. I '$$ACTIVPRV^PXAPI(PXCAPRV,PXCADT) S PXCA("ERROR","SKIN TEST",PXCAPRV,0,0)="Provider is not active or valid^"_PXCAPRV
|
---|
36 | .. E I PXCABULD!PXCAERRS D ANOTHPRV^PXCAPRV(PXCAPRV)
|
---|
37 | . S PXCAINDX=""
|
---|
38 | . F S PXCAINDX=$O(PXCA("SKIN TEST",PXCAPRV,PXCAINDX)) Q:PXCAINDX']"" D
|
---|
39 | .. S PXCASK=$G(PXCA("SKIN TEST",PXCAPRV,PXCAINDX))
|
---|
40 | .. S PXCANUMB=PXCANUMB+1
|
---|
41 | .. I PXCASK="" S PXCA("ERROR","SKIN TEST",PXCAPRV,PXCAINDX,0)="SKIN TEST data missing" Q
|
---|
42 | .. S PXCAITEM=+$P(PXCASK,"^",1)
|
---|
43 | .. I $G(^AUTTSK(PXCAITEM,0))="" S PXCA("ERROR","SKIN TEST",PXCAPRV,PXCAINDX,1)="SKIN TEST type not in file 9999999.28^"_PXCAITEM
|
---|
44 | .. S PXCAITEM=$P(PXCASK,"^",2)
|
---|
45 | .. I '((PXCAITEM=(PXCAITEM\1)&(PXCAITEM>-1)&(PXCAITEM<41))!(PXCAITEM="")) S PXCA("ERROR","SKIN TEST",PXCAPRV,PXCAINDX,2)="SKIN TEST reaction must be an integer form 0 to 40^"_PXCAITEM
|
---|
46 | .. S PXCAITEM=$P(PXCASK,"^",3)
|
---|
47 | .. I '(PXCAITEM=""!(PXCAITEM="P")!(PXCAITEM="N")!(PXCAITEM="D")!(PXCAITEM="O")) S PXCA("ERROR","SKIN TEST",PXCAPRV,PXCAINDX,3)="SKIN TEST results must be P|N|D|O^"_PXCAITEM
|
---|
48 | .. I PXCABULD&'$D(PXCA("ERROR","SKIN TEST",PXCAPRV,PXCAINDX))!PXCAERRS D SK(PXCASK,.PXCANUMB,PXCAPRV,PXCAERRS)
|
---|
49 | Q
|
---|
50 | ;
|
---|