PXRMSTAT ; SLC/PKR - Routines for dealing with status. ;29-Nov-2017 09:31;DU
;;2.0;CLINICAL REMINDERS;**4,1005,1009**;Feb 04, 2005;Build 17
;IHS/MSC/MGH Add IHS problem statuses
;===============================================
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)=4,STATUSA(1)="A"
. ;IHS/MSC/MGH Add IHS statuses - Patch 1009 added status R
. S STATUSA(2)="S",STATUSA(3)="E",STATUSA(4)="O",STATUSA(5)="R"
Q
;
;===============================================
GETSTATI(FILENUM,FINDPA,STATUSA,TAXIEN) ;Return the list of statuses to search
;for in the array STATUSA. STATUSA(0) will contain the number found.
N IND,NUM
S TAXIEN=$G(TAXIEN)
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'="" D
...I STAT="A" D ADDSTAT
...I STAT="I" S NUM=NUM+1,STATUSA(NUM)="I"
. I NUM>0 S STATUSA(0)=NUM
. ;I NUM=0 S STATUSA(0)=1,STATUSA(1)="A"
. I NUM=0 D ADDSTAT S STATUSA(0)=NUM
.;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
;
ADDSTAT ;Add active statuses
S NUM=NUM+1,STATUSA(NUM)="A"
S NUM=NUM+1,STATUSA(NUM)="E"
S NUM=NUM+1,STATUSA(NUM)="S"
S NUM=NUM+1,STATUSA(NUM)="O"
S NUM=NUM+1,STATUSA(NUM)="R"
;IHS/MSC/MGH added for inactive problems
I +TAXIEN D
.I $P($G(^PXD(811.2,TAXIEN,0)),U,9)=1 S NUM=NUM+1,STATUSA(NUM)="I"
Q
PXRMSTAT ; SLC/PKR - Routines for dealing with status. ;29-Nov-2017 09:31;DU
+1 ;;2.0;CLINICAL REMINDERS;**4,1005,1009**;Feb 04, 2005;Build 17
+2 ;IHS/MSC/MGH Add IHS problem statuses
+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)=4
SET STATUSA(1)="A"
+28 ;IHS/MSC/MGH Add IHS statuses - Patch 1009 added status R
+29 SET STATUSA(2)="S"
SET STATUSA(3)="E"
SET STATUSA(4)="O"
SET STATUSA(5)="R"
End DoDot:1
QUIT
+30 QUIT
+31 ;
+32 ;===============================================
GETSTATI(FILENUM,FINDPA,STATUSA,TAXIEN) ;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 SET TAXIEN=$GET(TAXIEN)
+4 KILL STATUSA
+5 SET (IND,NUM)=0
+6 ;Do Problem List first because it is a special case.
+7 IF FILENUM=9000011
Begin DoDot:1
+8 NEW STAT
+9 FOR
SET IND=+$ORDER(FINDPA(5,IND))
IF IND=0
QUIT
Begin DoDot:2
+10 SET STAT=$SELECT(FINDPA(5,IND)="ACTIVE":"A",FINDPA(5,IND)="INACTIVE":"I",1:"")
+11 IF STAT'=""
Begin DoDot:3
+12 IF STAT="A"
DO ADDSTAT
+13 IF STAT="I"
SET NUM=NUM+1
SET STATUSA(NUM)="I"
End DoDot:3
End DoDot:2
+14 IF NUM>0
SET STATUSA(0)=NUM
+15 ;I NUM=0 S STATUSA(0)=1,STATUSA(1)="A"
+16 IF NUM=0
DO ADDSTAT
SET STATUSA(0)=NUM
+17 ;If the status multiple is not defined check USE INACTIVE PROBLEMS
+18 IF '$DATA(FINDPA(5))
IF $PIECE($GET(FINDPA(0)),U,9)
SET STATUSA(0)=2
SET STATUSA(2)="I"
End DoDot:1
QUIT
+19 ;
+20 ;See if a status list is defined, if it is use it.
+21 FOR
SET IND=+$ORDER(FINDPA(5,IND))
IF IND=0
QUIT
Begin DoDot:1
+22 SET NUM=NUM+1
SET STATUSA(NUM)=FINDPA(5,IND)
End DoDot:1
+23 IF NUM>0
SET STATUSA(0)=NUM
QUIT
+24 ;
+25 ;If no list is defined set the default statuses.
+26 DO DEFAULT(FILENUM,.STATUSA)
+27 QUIT
+28 ;
ADDSTAT ;Add active statuses
+1 SET NUM=NUM+1
SET STATUSA(NUM)="A"
+2 SET NUM=NUM+1
SET STATUSA(NUM)="E"
+3 SET NUM=NUM+1
SET STATUSA(NUM)="S"
+4 SET NUM=NUM+1
SET STATUSA(NUM)="O"
+5 SET NUM=NUM+1
SET STATUSA(NUM)="R"
+6 ;IHS/MSC/MGH added for inactive problems
+7 IF +TAXIEN
Begin DoDot:1
+8 IF $PIECE($GET(^PXD(811.2,TAXIEN,0)),U,9)=1
SET NUM=NUM+1
SET STATUSA(NUM)="I"
End DoDot:1
+9 QUIT
