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 Dec 13, 2024@01:49:16 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 ;
