| 1 | PXRMSTAT ; SLC/PKR - Routines for dealing with status. ;07/11/2005
|
|---|
| 2 | ;;2.0;CLINICAL REMINDERS;**4**;Feb 04, 2005;Build 21
|
|---|
| 3 | ;
|
|---|
| 4 | ;===============================================
|
|---|
| 5 | DEFAULT(FILENUM,STATUSA) ;Given the file number return the default
|
|---|
| 6 | ;statuses.
|
|---|
| 7 | ;Outpatient medications
|
|---|
| 8 | I FILENUM=52 D Q
|
|---|
| 9 | . S STATUSA(0)=5,STATUSA(1)="ACTIVE",STATUSA(2)="DISCONTINUED"
|
|---|
| 10 | . S STATUSA(3)="DISCONTINUED (EDIT)",STATUSA(4)="EXPIRED"
|
|---|
| 11 | . S STATUSA(5)="SUSPENDED"
|
|---|
| 12 | ;
|
|---|
| 13 | ;Inpatient medications
|
|---|
| 14 | I FILENUM=55 D Q
|
|---|
| 15 | . S STATUSA(0)=4,STATUSA(1)="ACTIVE",STATUSA(2)="DISCONTINUED (EDIT)"
|
|---|
| 16 | . S STATUSA(3)="DISCONTINUED (RENEWAL)",STATUSA(4)="EXPIRED"
|
|---|
| 17 | ;
|
|---|
| 18 | ;Non-VA meds
|
|---|
| 19 | I FILENUM="55NVA" D Q
|
|---|
| 20 | . S STATUSA(0)=1,STATUSA(1)="ACTIVE"
|
|---|
| 21 | ;
|
|---|
| 22 | ;Radiology procedures
|
|---|
| 23 | I FILENUM=70 D Q
|
|---|
| 24 | . S STATUSA(0)=1,STATUSA(1)="COMPLETE"
|
|---|
| 25 | ;
|
|---|
| 26 | ;Orders
|
|---|
| 27 | I FILENUM=100 D Q
|
|---|
| 28 | . S STATUSA(0)=2,STATUSA(1)="ACTIVE",STATUSA(2)="PENDING"
|
|---|
| 29 | ;
|
|---|
| 30 | ;Problem List
|
|---|
| 31 | I FILENUM=9000011 D Q
|
|---|
| 32 | . S STATUSA(0)=1,STATUSA(1)="A"
|
|---|
| 33 | Q
|
|---|
| 34 | ;
|
|---|
| 35 | ;===============================================
|
|---|
| 36 | GETSTATI(FILENUM,FINDPA,STATUSA) ;Return the list of statuses to search
|
|---|
| 37 | ;for in the array STATUSA. STATUSA(0) will contain the number found.
|
|---|
| 38 | N IND,NUM
|
|---|
| 39 | K STATUSA
|
|---|
| 40 | S (IND,NUM)=0
|
|---|
| 41 | ;Do Problem List first because it is a special case.
|
|---|
| 42 | I FILENUM=9000011 D Q
|
|---|
| 43 | . N STAT
|
|---|
| 44 | . F S IND=+$O(FINDPA(5,IND)) Q:IND=0 D
|
|---|
| 45 | .. S STAT=$S(FINDPA(5,IND)="ACTIVE":"A",FINDPA(5,IND)="INACTIVE":"I",1:"")
|
|---|
| 46 | .. I STAT'="" S NUM=NUM+1,STATUSA(NUM)=STAT
|
|---|
| 47 | . I NUM>0 S STATUSA(0)=NUM
|
|---|
| 48 | . I NUM=0 S STATUSA(0)=1,STATUSA(1)="A"
|
|---|
| 49 | .;If the status multiple is not defined check USE INACTIVE PROBLEMS
|
|---|
| 50 | . I '$D(FINDPA(5)),$P($G(FINDPA(0)),U,9) S STATUSA(0)=2,STATUSA(2)="I"
|
|---|
| 51 | ;
|
|---|
| 52 | ;See if a status list is defined, if it is use it.
|
|---|
| 53 | F S IND=+$O(FINDPA(5,IND)) Q:IND=0 D
|
|---|
| 54 | . S NUM=NUM+1,STATUSA(NUM)=FINDPA(5,IND)
|
|---|
| 55 | I NUM>0 S STATUSA(0)=NUM Q
|
|---|
| 56 | ;
|
|---|
| 57 | ;If no list is defined set the default statuses.
|
|---|
| 58 | D DEFAULT(FILENUM,.STATUSA)
|
|---|
| 59 | Q
|
|---|
| 60 | ;
|
|---|
