- PXRMSTAT ; SLC/PKR - Routines for dealing with status. ;07/11/2005
- ;;2.0;CLINICAL REMINDERS;**4**;Feb 04, 2005;Build 21
- ;
- ;===============================================
- DEFAULT(FILENUM,STATUSA) ;Given the file number return the default
- ;statuses.
- ;Outpatient medications
- I FILENUM=52 D Q
- . S STATUSA(0)=5,STATUSA(1)="ACTIVE",STATUSA(2)="DISCONTINUED"
- . S STATUSA(3)="DISCONTINUED (EDIT)",STATUSA(4)="EXPIRED"
- . S STATUSA(5)="SUSPENDED"
- ;
- ;Inpatient medications
- I FILENUM=55 D Q
- . S STATUSA(0)=4,STATUSA(1)="ACTIVE",STATUSA(2)="DISCONTINUED (EDIT)"
- . S STATUSA(3)="DISCONTINUED (RENEWAL)",STATUSA(4)="EXPIRED"
- ;
- ;Non-VA meds
- I FILENUM="55NVA" D Q
- . S STATUSA(0)=1,STATUSA(1)="ACTIVE"
- ;
- ;Radiology procedures
- I FILENUM=70 D Q
- . S STATUSA(0)=1,STATUSA(1)="COMPLETE"
- ;
- ;Orders
- I FILENUM=100 D Q
- . S STATUSA(0)=2,STATUSA(1)="ACTIVE",STATUSA(2)="PENDING"
- ;
- ;Problem List
- I FILENUM=9000011 D Q
- . S STATUSA(0)=1,STATUSA(1)="A"
- Q
- ;
- ;===============================================
- GETSTATI(FILENUM,FINDPA,STATUSA) ;Return the list of statuses to search
- ;for in the array STATUSA. STATUSA(0) will contain the number found.
- N IND,NUM
- K STATUSA
- S (IND,NUM)=0
- ;Do Problem List first because it is a special case.
- I FILENUM=9000011 D Q
- . N STAT
- . F S IND=+$O(FINDPA(5,IND)) Q:IND=0 D
- .. S STAT=$S(FINDPA(5,IND)="ACTIVE":"A",FINDPA(5,IND)="INACTIVE":"I",1:"")
- .. I STAT'="" S NUM=NUM+1,STATUSA(NUM)=STAT
- . I NUM>0 S STATUSA(0)=NUM
- . I NUM=0 S STATUSA(0)=1,STATUSA(1)="A"
- .;If the status multiple is not defined check USE INACTIVE PROBLEMS
- . I '$D(FINDPA(5)),$P($G(FINDPA(0)),U,9) S STATUSA(0)=2,STATUSA(2)="I"
- ;
- ;See if a status list is defined, if it is use it.
- F S IND=+$O(FINDPA(5,IND)) Q:IND=0 D
- . S NUM=NUM+1,STATUSA(NUM)=FINDPA(5,IND)
- I NUM>0 S STATUSA(0)=NUM Q
- ;
- ;If no list is defined set the default statuses.
- D DEFAULT(FILENUM,.STATUSA)
- Q
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMSTAT 1968 printed Jan 18, 2025@02:50:29 Page 2
- PXRMSTAT ; SLC/PKR - Routines for dealing with status. ;07/11/2005
- +1 ;;2.0;CLINICAL REMINDERS;**4**;Feb 04, 2005;Build 21
- +2 ;
- +3 ;===============================================
- DEFAULT(FILENUM,STATUSA) ;Given the file number return the default
- +1 ;statuses.
- +2 ;Outpatient medications
- +3 IF FILENUM=52
- Begin DoDot:1
- +4 SET STATUSA(0)=5
- SET STATUSA(1)="ACTIVE"
- SET STATUSA(2)="DISCONTINUED"
- +5 SET STATUSA(3)="DISCONTINUED (EDIT)"
- SET STATUSA(4)="EXPIRED"
- +6 SET STATUSA(5)="SUSPENDED"
- End DoDot:1
- QUIT
- +7 ;
- +8 ;Inpatient medications
- +9 IF FILENUM=55
- Begin DoDot:1
- +10 SET STATUSA(0)=4
- SET STATUSA(1)="ACTIVE"
- SET STATUSA(2)="DISCONTINUED (EDIT)"
- +11 SET STATUSA(3)="DISCONTINUED (RENEWAL)"
- SET STATUSA(4)="EXPIRED"
- End DoDot:1
- QUIT
- +12 ;
- +13 ;Non-VA meds
- +14 IF FILENUM="55NVA"
- Begin DoDot:1
- +15 SET STATUSA(0)=1
- SET STATUSA(1)="ACTIVE"
- End DoDot:1
- QUIT
- +16 ;
- +17 ;Radiology procedures
- +18 IF FILENUM=70
- Begin DoDot:1
- +19 SET STATUSA(0)=1
- SET STATUSA(1)="COMPLETE"
- End DoDot:1
- QUIT
- +20 ;
- +21 ;Orders
- +22 IF FILENUM=100
- Begin DoDot:1
- +23 SET STATUSA(0)=2
- SET STATUSA(1)="ACTIVE"
- SET STATUSA(2)="PENDING"
- End DoDot:1
- QUIT
- +24 ;
- +25 ;Problem List
- +26 IF FILENUM=9000011
- Begin DoDot:1
- +27 SET STATUSA(0)=1
- SET STATUSA(1)="A"
- End DoDot:1
- QUIT
- +28 QUIT
- +29 ;
- +30 ;===============================================
- GETSTATI(FILENUM,FINDPA,STATUSA) ;Return the list of statuses to search
- +1 ;for in the array STATUSA. STATUSA(0) will contain the number found.
- +2 NEW IND,NUM
- +3 KILL STATUSA
- +4 SET (IND,NUM)=0
- +5 ;Do Problem List first because it is a special case.
- +6 IF FILENUM=9000011
- Begin DoDot:1
- +7 NEW STAT
- +8 FOR
- SET IND=+$ORDER(FINDPA(5,IND))
- if IND=0
- QUIT
- Begin DoDot:2
- +9 SET STAT=$SELECT(FINDPA(5,IND)="ACTIVE":"A",FINDPA(5,IND)="INACTIVE":"I",1:"")
- +10 IF STAT'=""
- SET NUM=NUM+1
- SET STATUSA(NUM)=STAT
- End DoDot:2
- +11 IF NUM>0
- SET STATUSA(0)=NUM
- +12 IF NUM=0
- SET STATUSA(0)=1
- SET STATUSA(1)="A"
- +13 ;If the status multiple is not defined check USE INACTIVE PROBLEMS
- +14 IF '$DATA(FINDPA(5))
- IF $PIECE($GET(FINDPA(0)),U,9)
- SET STATUSA(0)=2
- SET STATUSA(2)="I"
- End DoDot:1
- QUIT
- +15 ;
- +16 ;See if a status list is defined, if it is use it.
- +17 FOR
- SET IND=+$ORDER(FINDPA(5,IND))
- if IND=0
- QUIT
- Begin DoDot:1
- +18 SET NUM=NUM+1
- SET STATUSA(NUM)=FINDPA(5,IND)
- End DoDot:1
- +19 IF NUM>0
- SET STATUSA(0)=NUM
- QUIT
- +20 ;
- +21 ;If no list is defined set the default statuses.
- +22 DO DEFAULT(FILENUM,.STATUSA)
- +23 QUIT
- +24 ;