| [613] | 1 | IBDF18E4 ;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 | ;
|
|---|
| 8 | GAF ;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
|
|---|
