- PXRMIOPT ;SLC/PKR - Computed finding in/out patient status. ;02/06/2019
- ;;2.0;CLINICAL REMINDERS;**42**;Feb 04, 2005;Build 245
- ;
- ;====================
- IOPT(DFN,NGET,BDT,EDT,NFOUND,TEST,DATE,FIDATA,TEXT) ;Routine for the computed
- ;finding VA-INPATIENT/OUTPATIENT FINDINGS.
- N ABBR,ABLIST,DEFARR,FIEN,FIEVAL,FILENUM,FIMOD,FIMODS,FIMODV
- N FINDING,INOUT,ROOT,TFINDING
- ;
- S TFINDING=$P(TEST,U,1)
- S INOUT=$P(TEST,U,2)
- S FIMODS=$P(TEST,U,3)
- I INOUT="" S INOUT="INP"
- S (NFOUND,TEST)=0
- I TFINDING="" Q
- I (INOUT'="INP"),(INOUT'="OUT") Q
- ;
- S ABBR=$P(TFINDING,".",1),FINDING=$P(TFINDING,".",2)
- D BLDALIST^PXRMVPTR(811.902,.01,.ABLIST)
- I '$D(ABLIST(ABBR)) Q
- S FILENUM=$P(ABLIST(ABBR),U,1)
- S FIEN=+$$FIND1^DIC(FILENUM,"","ABX",FINDING)
- I FIEN=0 Q
- S ROOT=$P($$ROOT^DILFD(FILENUM),U,2)
- S DEFARR(20,1,0)=FIEN_";"_ROOT
- S $P(DEFARR(20,1,0),U,9)=BDT
- S $P(DEFARR(20,1,0),U,11)=EDT
- S $P(DEFARR(20,1,0),U,14)=NGET
- ;For health factors, Within Category Rank defaults to 0.
- S $P(DEFARR(20,1,0),U,10)=0
- ;If a Finding Modifier was passed set it.
- I FIMODS'="" D
- . S FIMOD=$P(FIMODS,":",1)
- . S FIMODV=$P(FIMODS,":",2)
- . I FIMOD="USE INACTIVE PROBLEMS" S $P(DEFARR(20,1,0),U,9)=FIMODV
- . I FIMOD="WITHIN CATEGORY RANK" S $P(DEFARR(20,1,0),U,10)=FIMODV
- . I FIMOD="MH SCALE" S $P(DEFARR(20,1,0),U,12)=FIMODV
- . I FIMOD="RX TYPE" S $P(DEFARR(20,1,0),U,13)=FIMODV
- . I FIMOD="USE START DATE" S $P(DEFARR(20,1,0),U,15)=FIMODV
- . I FIMOD="INCLUDE VISIT DATA" S $P(DEFARR(20,1,0),U,16)=FIMODV
- S DEFARR("E",ROOT,FIEN,1)=""
- D EVAL^PXRMEVFI(DFN,.DEFARR,.FIEVAL)
- I FIEVAL(1)=0 Q
- ;
- N DATAINP,DATEINP,FINAME,IND,INPT,JND,JNDS,KND,MSG,NFINP,TESTINP,TEXTINP
- S TESTINP=""
- D WASINP^PXRMPDEM(DFN,99,BDT,EDT,.NFINP,.TESTINP,.DATEINP,.DATAINP,.TEXTINP)
- I (NFINP=0),(INOUT="INP") Q
- I (NFINP=0),(INOUT="OUT") D Q
- . S IND=0
- . F S IND=+$O(FIEVAL(1,IND)) Q:IND=0 D
- .. I FIEVAL(1,IND)=1 S NFOUND=NFOUND+1,DATE(NFOUND)=FIEVAL(1,IND,"DATE"),TEST(NFOUND)=1
- S FINAME=ABBR_"."_$$GET1^DIQ(FILENUM,FIEN_",",.01,"","","MSG")
- S (IND,NFOUND)=0
- F S IND=+$O(FIEVAL(1,IND)) Q:IND=0 D
- . I FIEVAL(1,IND)=0 Q
- . S INPT=0
- . F JND=1:1:NFINP D
- .. S INPT=((FIEVAL(1,IND,"DATE"))'<(DATAINP(JND,"ADMISSION DATE")))&((FIEVAL(1,IND,"DATE"))'>(DATAINP(JND,"DISCHARGE DATE")))
- .. I INPT=1 S JNDS=JND,JND=NFINP
- .;If INPT is true then the finding occurred during an inpatient stay.
- . I ((INOUT="INP")&(INPT))!((INOUT="OUT")&('INPT))&(NFOUND<NGET) D
- .. S NFOUND=NFOUND+1
- .. S TEST(NFOUND)=1
- .. S DATE(NFOUND)=FIEVAL(1,IND,"DATE")
- .. I $G(PXRMDEBG)=1 K FIEVAL(1,IND,"CSUB")
- .. S KND=1
- .. F S KND=$O(FIEVAL(1,IND,KND)) Q:KND="" M FIDATA(NFOUND,KND)=FIEVAL(1,IND,KND)
- .. I INOUT="INP" S TEXT(NFOUND)=TEXTINP(JNDS)_"\\"_FINAME_" "_$$EDATE^PXRMDATE(FIEVAL(1,IND,"DATE"))
- .. I INOUT="OUT" S TEXT(NFOUND)="This instance of "_FINAME_" occurred outside of all inpatient stays."
- Q
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMIOPT 2930 printed Mar 13, 2025@20:50:55 Page 2
- PXRMIOPT ;SLC/PKR - Computed finding in/out patient status. ;02/06/2019
- +1 ;;2.0;CLINICAL REMINDERS;**42**;Feb 04, 2005;Build 245
- +2 ;
- +3 ;====================
- IOPT(DFN,NGET,BDT,EDT,NFOUND,TEST,DATE,FIDATA,TEXT) ;Routine for the computed
- +1 ;finding VA-INPATIENT/OUTPATIENT FINDINGS.
- +2 NEW ABBR,ABLIST,DEFARR,FIEN,FIEVAL,FILENUM,FIMOD,FIMODS,FIMODV
- +3 NEW FINDING,INOUT,ROOT,TFINDING
- +4 ;
- +5 SET TFINDING=$PIECE(TEST,U,1)
- +6 SET INOUT=$PIECE(TEST,U,2)
- +7 SET FIMODS=$PIECE(TEST,U,3)
- +8 IF INOUT=""
- SET INOUT="INP"
- +9 SET (NFOUND,TEST)=0
- +10 IF TFINDING=""
- QUIT
- +11 IF (INOUT'="INP")
- IF (INOUT'="OUT")
- QUIT
- +12 ;
- +13 SET ABBR=$PIECE(TFINDING,".",1)
- SET FINDING=$PIECE(TFINDING,".",2)
- +14 DO BLDALIST^PXRMVPTR(811.902,.01,.ABLIST)
- +15 IF '$DATA(ABLIST(ABBR))
- QUIT
- +16 SET FILENUM=$PIECE(ABLIST(ABBR),U,1)
- +17 SET FIEN=+$$FIND1^DIC(FILENUM,"","ABX",FINDING)
- +18 IF FIEN=0
- QUIT
- +19 SET ROOT=$PIECE($$ROOT^DILFD(FILENUM),U,2)
- +20 SET DEFARR(20,1,0)=FIEN_";"_ROOT
- +21 SET $PIECE(DEFARR(20,1,0),U,9)=BDT
- +22 SET $PIECE(DEFARR(20,1,0),U,11)=EDT
- +23 SET $PIECE(DEFARR(20,1,0),U,14)=NGET
- +24 ;For health factors, Within Category Rank defaults to 0.
- +25 SET $PIECE(DEFARR(20,1,0),U,10)=0
- +26 ;If a Finding Modifier was passed set it.
- +27 IF FIMODS'=""
- Begin DoDot:1
- +28 SET FIMOD=$PIECE(FIMODS,":",1)
- +29 SET FIMODV=$PIECE(FIMODS,":",2)
- +30 IF FIMOD="USE INACTIVE PROBLEMS"
- SET $PIECE(DEFARR(20,1,0),U,9)=FIMODV
- +31 IF FIMOD="WITHIN CATEGORY RANK"
- SET $PIECE(DEFARR(20,1,0),U,10)=FIMODV
- +32 IF FIMOD="MH SCALE"
- SET $PIECE(DEFARR(20,1,0),U,12)=FIMODV
- +33 IF FIMOD="RX TYPE"
- SET $PIECE(DEFARR(20,1,0),U,13)=FIMODV
- +34 IF FIMOD="USE START DATE"
- SET $PIECE(DEFARR(20,1,0),U,15)=FIMODV
- +35 IF FIMOD="INCLUDE VISIT DATA"
- SET $PIECE(DEFARR(20,1,0),U,16)=FIMODV
- End DoDot:1
- +36 SET DEFARR("E",ROOT,FIEN,1)=""
- +37 DO EVAL^PXRMEVFI(DFN,.DEFARR,.FIEVAL)
- +38 IF FIEVAL(1)=0
- QUIT
- +39 ;
- +40 NEW DATAINP,DATEINP,FINAME,IND,INPT,JND,JNDS,KND,MSG,NFINP,TESTINP,TEXTINP
- +41 SET TESTINP=""
- +42 DO WASINP^PXRMPDEM(DFN,99,BDT,EDT,.NFINP,.TESTINP,.DATEINP,.DATAINP,.TEXTINP)
- +43 IF (NFINP=0)
- IF (INOUT="INP")
- QUIT
- +44 IF (NFINP=0)
- IF (INOUT="OUT")
- Begin DoDot:1
- +45 SET IND=0
- +46 FOR
- SET IND=+$ORDER(FIEVAL(1,IND))
- if IND=0
- QUIT
- Begin DoDot:2
- +47 IF FIEVAL(1,IND)=1
- SET NFOUND=NFOUND+1
- SET DATE(NFOUND)=FIEVAL(1,IND,"DATE")
- SET TEST(NFOUND)=1
- End DoDot:2
- End DoDot:1
- QUIT
- +48 SET FINAME=ABBR_"."_$$GET1^DIQ(FILENUM,FIEN_",",.01,"","","MSG")
- +49 SET (IND,NFOUND)=0
- +50 FOR
- SET IND=+$ORDER(FIEVAL(1,IND))
- if IND=0
- QUIT
- Begin DoDot:1
- +51 IF FIEVAL(1,IND)=0
- QUIT
- +52 SET INPT=0
- +53 FOR JND=1:1:NFINP
- Begin DoDot:2
- +54 SET INPT=((FIEVAL(1,IND,"DATE"))'<(DATAINP(JND,"ADMISSION DATE")))&((FIEVAL(1,IND,"DATE"))'>(DATAINP(JND,"DISCHARGE DATE")))
- +55 IF INPT=1
- SET JNDS=JND
- SET JND=NFINP
- End DoDot:2
- +56 ;If INPT is true then the finding occurred during an inpatient stay.
- +57 IF ((INOUT="INP")&(INPT))!((INOUT="OUT")&('INPT))&(NFOUND<NGET)
- Begin DoDot:2
- +58 SET NFOUND=NFOUND+1
- +59 SET TEST(NFOUND)=1
- +60 SET DATE(NFOUND)=FIEVAL(1,IND,"DATE")
- +61 IF $GET(PXRMDEBG)=1
- KILL FIEVAL(1,IND,"CSUB")
- +62 SET KND=1
- +63 FOR
- SET KND=$ORDER(FIEVAL(1,IND,KND))
- if KND=""
- QUIT
- MERGE FIDATA(NFOUND,KND)=FIEVAL(1,IND,KND)
- +64 IF INOUT="INP"
- SET TEXT(NFOUND)=TEXTINP(JNDS)_"\\"_FINAME_" "_$$EDATE^PXRMDATE(FIEVAL(1,IND,"DATE"))
- +65 IF INOUT="OUT"
- SET TEXT(NFOUND)="This instance of "_FINAME_" occurred outside of all inpatient stays."
- End DoDot:2
- End DoDot:1
- +66 QUIT
- +67 ;
