- 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
