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

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

initial load of WorldVistAEHR

File size: 2.7 KB
RevLine 
[613]1PXCASK ;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 ;
12SK(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 ;
28SKINTEST(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 ;
Note: See TracBrowser for help on using the repository browser.