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

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

initial load of WorldVistAEHR

File size: 1.8 KB
RevLine 
[613]1PXAIHF ;ISL/PKR - Set the HEALTH FACTOR nodes. ;12/18/97
2 ;;1.0;PCE PATIENT CARE ENCOUNTER;**45**;Aug 12, 1996
3 ;
4HF ;Main entry point.
5 ;
6 K PXAERR
7 S PXAERR(8)=PXAK
8 S PXAERR(7)="HEALTH FACTOR"
9 ;
10 N IND,PXAA
11 S IND=""
12 F S IND=$O(@PXADATA@("HEALTH FACTOR",PXAK,IND)) Q:IND="" D
13 . S PXAA(IND)=@PXADATA@("HEALTH FACTOR",PXAK,IND)
14 ;
15 ;Validate the data.
16 N STOP
17 D VAL^PXAIHFV
18 I $G(STOP) Q
19 ;
20SETVARA ;Set the after visit variables.
21 N AFTER0,AFTER12,AFTER811,AFTER812
22 S $P(AFTER0,U,1)=$G(PXAA("HEALTH FACTOR"))
23 I $G(PXAA("DELETE")) S $P(AFTER0,U,1)="@"
24 S $P(AFTER0,U,2)=$G(PATIENT)
25 S $P(AFTER0,U,3)=$G(PXAVISIT)
26 S $P(AFTER0,U,4)=$G(PXAA("LEVEL/SEVERITY"))
27 S $P(AFTER12,U,1)=$G(PXAA("EVENT D/T"))
28 S $P(AFTER12,U,4)=$G(PXAA("ENC PROVIDER"))
29 S $P(AFTER811,U,1)=$G(PXAA("COMMENT"))
30 ;
31 ;--PACKAGE AND SOURCE
32 S $P(AFTER812,"^",2)=$G(PXAPKG)
33 S $P(AFTER812,"^",3)=$G(PXASOURC)
34 ;
35 S ^TMP("PXK",$J,"HF",PXAK,0,"AFTER")=AFTER0
36 S ^TMP("PXK",$J,"HF",PXAK,12,"AFTER")=AFTER12
37 S ^TMP("PXK",$J,"HF",PXAK,811,"AFTER")=AFTER811
38 S ^TMP("PXK",$J,"HF",PXAK,812,"AFTER")=AFTER812
39 ;
40SETVARB ;Set the before variables.
41 N BEFOR0,BEFOR12,BEFOR811,BEFOR812
42 N IENB,PXAAX,PXBCNT,PXBKY,PXBSKY,PXBSAM
43 D HF^PXBGHF(PXAVISIT)
44 ;
45 S IENB=""
46 I PXBCNT>0 D
47 . S PXAAX("HEALTH FACTOR")=$P($G(^AUTTHF(PXAA("HEALTH FACTOR"),0)),U,1)
48 . S IENB=$O(PXBKY(PXAAX("HEALTH FACTOR"),IENB))
49 I $G(IENB) D
50 . S BEFOR0=$G(^AUPNVHF(IENB,0))
51 . S BEFOR12=$G(^AUPNVHF(IENB,12))
52 . S BEFOR811=$G(^AUPNVHF(IENB,811))
53 . S BEFOR812=$G(^AUPNVHF(IENB,812))
54 E S (BEFOR0,BEFOR11,BEFOR12,BEFOR811,BEFOR812)=""
55 ;
56 S ^TMP("PXK",$J,"HF",PXAK,0,"BEFORE")=BEFOR0
57 S ^TMP("PXK",$J,"HF",PXAK,12,"BEFORE")=BEFOR12
58 S ^TMP("PXK",$J,"HF",PXAK,811,"BEFORE")=BEFOR811
59 S ^TMP("PXK",$J,"HF",PXAK,812,"BEFORE")=BEFOR812
60 S ^TMP("PXK",$J,"HF",PXAK,"IEN")=IENB
61 ;
62 Q
Note: See TracBrowser for help on using the repository browser.