source: WorldVistAEHR/trunk/r/AUTOMATED_INFO_COLLECTION_SYS-IBD/IBDF18E4.m@ 724

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

initial load of WorldVistAEHR
File size: 2.5 KB
Line 
1IBDF18E4 ;ALB/DHH - ENCOUNTER FORM - MISC INTERFACES utilities ;19-JUN-01
2 ;;3.0;AUTOMATED INFO COLLECTION SYS;**37**;APR 24, 1997
3 ;
4 ;-- this routine is to be called after PXCA is called in order to
5 ; send additional information to other packages that PCE does not
6 ; send to currently
7 ;
8GAF ;send GAF information to Mental Health
9 ;
10 ;-- GAF information is filed with Mental Health only if the following
11 ; variables are set
12 ; -- DFN = Patient IEN
13 ; SCORE = GAF Score
14 ; PROV = Provider holding SD GAF SCORE security key
15 ; DATE = Encounter Date/Time
16 ; VISIT = Inpatient or Outpatient Visit
17 ;
18 N DIG1,DIG2,DIG3,EPROV,SCORE,PROV,DATE,VISIT,X,DFN
19 S (SCORE,PROV,DATE,VISIT)=""
20 ;
21 ; --if pxca (ibd gaf score col 3) exist the there should be 3
22 ; columns present to make the 3 character number
23 ;
24 I $D(PXCA("IBD GAF SCORE COL 3")) D
25 . ;
26 . S (DIG1,DIG2,DIG3)=""
27 . ;
28 . ; checking to see if column 3 is existing
29 . ; column 1 and 2 are not required to make score
30 . ;
31 . Q:'$D(PXCA("IBD GAF SCORE COL 3"))
32 . S EPROV="" F S EPROV=$O(PXCA("IBD GAF SCORE COL 3",EPROV)) Q:EPROV="" D
33 .. ;
34 .. S DIG1=$P($G(PXCA("IBD GAF SCORE COL 1",EPROV,+$O(PXCA("IBD GAF SCORE COL 1",EPROV,0)))),"^",1)
35 .. S DIG2=$P($G(PXCA("IBD GAF SCORE COL 2",EPROV,+$O(PXCA("IBD GAF SCORE COL 2",EPROV,0)))),"^",1)
36 .. S DIG3=$P($G(PXCA("IBD GAF SCORE COL 3",EPROV,+$O(PXCA("IBD GAF SCORE COL 3",EPROV,0)))),"^",1)
37 .. S SCORE=DIG1_DIG2_DIG3
38 .. ;
39 .. ; -- score is required to be 1-100
40 .. ;
41 .. I SCORE>100 S SCORE=""
42 .. S PXCA("IBD GAF SCORE COL 1",EPROV,1)=SCORE
43 .. ;
44 I $D(PXCA("IBD GAF SCORE COL 1")) D
45 . S EPROV="" F S EPROV=$O(PXCA("IBD GAF SCORE COL 1",EPROV)) Q:EPROV="" D
46 .. S SCORE=$P($G(PXCA("IBD GAF SCORE COL 1",EPROV,+$O(PXCA("IBD GAF SCORE COL 1",EPROV,0)))),"^")
47 .. S PROV=$P($G(PXCA("IBD GAF SCORE PROVIDER",EPROV,+$O(PXCA("IBD GAF SCORE PROVIDER",EPROV,0)))),"^")
48 .. S DFN=$P($G(PXCA("ENCOUNTER")),"^",2)
49 .. S DATE=$P($G(PXCA("ENCOUNTER")),"^",14)
50 .. S VISIT=$S($P($G(PXCA("ENCOUNTER")),"^",3)="W":"I",1:"O")
51 .. ;
52 .. ; do error check and file error quit if error
53 .. ; -- if any mandated information is missing file an error
54 .. ; in AICS' error log.
55 .. ;
56 .. I DFN="" D LOGERR^IBDF18E2(3570005,.FORMID) Q
57 .. I SCORE>100!(SCORE<1) D LOGERR^IBDF18E2(3570005,.FORMID) Q
58 .. I DATE="" D LOGERR^IBDF18E2(3570005,.FORMID) Q
59 .. I PROV="" D LOGERR^IBDF18E2(3570005,.FORMID) Q
60 .. I VISIT="" D LOGERR^IBDF18E2(3570005,.FORMID) Q
61 .. D UPD^YSGAF(DFN,SCORE,DATE,PROV,VISIT)
62 Q
Note: See TracBrowser for help on using the repository browser.